diff --git a/Makefile b/Makefile
deleted file mode 100644
index 72465df..0000000
--- a/Makefile
+++ /dev/null
@@ -1,21 +0,0 @@
-
-.PHONY: all
-all:
- dune build @all --watch
-
-.PHONY: test
-test:
- dune test
-
-.PHONY: clean
-clean:
- dune clean
-
-.PHONY: fmt
-fmt:
- dune build @fmt --auto-promote
-
-.PHONY: setup
-setup:
- opam install dune ppx_deriving ppxlib ocamlformat ocaml-lsp-server ppx_inline_test -y
- opam install sexplib yojson tyxml -y
diff --git a/README.md b/README.md
index 9c6d43e..1d7b9e1 100644
--- a/README.md
+++ b/README.md
@@ -1,108 +1,3 @@
-# serde.ml
+# serde_json
-A serialization framework for OCaml inspired by [serde-rs](https://github.com/serde-rs).
-
-The main goals for `serde.ml` are:
-
-* **Serialization** -- take arbitary data structures from the user and turn them into specific formats with maximum efficiency.
-
-* **Deserialization** -- read arbitrary data that you parse into data structures of the user's choice with maximum efficiency.
-
-> NOTE: this is _super not ready_ for production yet, but all contributions are welcome <3
-
-```ocaml
-type rank = Captain | Chief_petty_officer [@@deriving serializer, deserializer]
-type t = { name : string; rank : rank } [@@deriving serializer, deserializer]
-
-let obrien = { name = "Miles O'Brien"; rank = Chief_petty_officer }
-let sisko = { name = "Benjamin Sisko"; rank = Captain }
-
-> Serde_json.to_string_pretty (serialize_t) obrien
-Ok "{ \"name\": \"Miles O'Brien\", \"rank\": \"Chief_petty_officer\" }"
-
-> Serde_json.of_string (deserialize_t) "{ \"name\": \"Miles O'Brien\", \"rank\": \"Chief_petty_officer\" }"
-Ok {name = "Miles O'Brien"; rank = Chief_petty_officer}
-
-> Serde_sexpr.to_string_pretty (serialize_t) obrien;;
-Ok "(\"Miles O'Brien\" :Chief_petty_officer)"
-
-> Serde_sexpr.of_string (deserialize_t) "(\"Miles O'Brien\" :Chief_petty_officer)";;
-Ok {name = "Miles O'Brien"; rank = Chief_petty_officer}
-```
-
-### Usage
-
-Set up the `serde_derive` ppx, and bring in any data format modules you want to use. Here we bring s-expressions and json.
-
-```dune
-(library
- (name my_lib)
- (preprocess (pps serde_derive))
- (libraries serde serde_derive serde_sexpr serde_json))
-```
-
-Tag your data structures with `deriving (serializer, deserializer)`.
-
-```ocaml
-open Serde
-
-type t =
- | Hello
- | Tuple1 of string
- | Tuple2 of string * bool
- | Record3 of { name : string; favorite_number : int; location : string }
-[@@deriving (serializer, deserializer)]
-```
-
-Now you have a `serialize_{typeName}` and `deserialize_{typeName}` functions that you can pass into the different data format modules.
-
-To read data, use `deserialize_t` like this:
-
-```ocaml
-let sexpr = "(:Record3 (\"Benjamin Sisko\" 9 \"Bajor\"))" in
-let* t = Serde_sexpr.of_string deserialize_t sexpr in
-t = (Record3 { name = "Benjamin Sisko"; favorite_number = 9; location = "Bajor" })
-```
-
-To render data, use `serialize_t` like this:
-
-```ocaml
-let t = (Record3 { name = "Benjamin Sisko"; favorite_number = 9; location = "Bajor" }) in
-let* sexpr = Serde_sexpr.to_string_pretty serialize_t t in
-sexpr = "(:Record3 (\"Benjamin Sisko\" 9 \"Bajor\"))"
-```
-
-To transcode data across formats, switch the data module:
-
-```ocaml
-(* read sexpr *)
-let sexpr = "(:Record3 (\"Benjamin Sisko\" 9 \"Bajor\"))" in
-let* t = Serde_sexpr.of_string deserialize_t sexpr in
-(* write json *)
-let* json = Serde_json.to_string_pretty serialize_t t in
-json = "{
- \"t#Record3\": {
- \"name\": \"Benjamin Sisko\",
- \"favorite_number\": 9,
- \"location\": \"Deep Space 9\"
- }
-}"
-```
-
-## Contributing
-
-Check the [CONTRIBUTING.md](./CONTRIBUTING.md) for a small guide on how to
-implement new data formats.
-
-## Advanced Use: Custom Serializer/Deserializer
-
-Serde.ml is capable of deriving the right serializer/deserializer for your
-types (and it if doesn't, that's a bug!) but in some cases you want to fit some
-external data format into an existing internal representation without having to
-add an extra layer.
-
-In those cases, you can implement a Serde _Visitor_ and customize absolutely
-everything about it. You can get started by using `serde_derive` and `dune
-describe pp` to expand the derivation. This will give you a solid starting
-point for your data type, where you can see how the generated Visitor drives
-the Deserializer by asking it to deserialize specific datatypes.
+JSON support for Serde, a serialization framework for OCaml.
diff --git a/derive/attributes.ml b/derive/attributes.ml
deleted file mode 100644
index 0351472..0000000
--- a/derive/attributes.ml
+++ /dev/null
@@ -1,81 +0,0 @@
-open Ppxlib
-
-type type_attributes = {
- rename : string;
- mode :
- [ `tag of string
- | `tag_and_content of string * string
- | `untagged
- | `normal ];
- rename_all :
- [ `lowercase
- | `UPPERCASE
- | `camelCase
- | `PascalCase
- | `snake_case
- | `SCREAMING_SNAKE_CASE
- | `kebab_case
- | `SCREAMING_KEBAB_CASE ]
- option;
- error_on_unknown_fields : bool;
-}
-
-type variant_attributes = {
- rename : string;
- should_skip : [ `skip_serializing | `skip_deserializing | `always | `never ];
- is_catch_all : bool;
-}
-
-type field_attributes = {
- name : string;
- presence : [ `required | `optional | `with_default of Parsetree.expression ];
- should_skip :
- [ `skip_serializing_if of string
- | `skip_deserializing_if of string
- | `always
- | `never ];
-}
-
-let of_field_attributes lbl =
- let open Ppxlib in
- let name = ref lbl.pld_name.txt in
- let should_skip = ref `never in
- let presence =
- ref
- (match lbl.pld_type.ptyp_desc with
- | Ptyp_constr ({ txt = Lident "option"; _ }, _) -> `optional
- | _ -> `required)
- in
- let () =
- match lbl.pld_attributes with
- | [
- {
- attr_name = { txt = "serde"; _ };
- attr_payload =
- PStr
- [
- {
- pstr_desc =
- Pstr_eval ({ pexp_desc = Pexp_record (fields, _); _ }, _);
- _;
- };
- ];
- _;
- };
- ] ->
- List.iter
- (fun (label, expr) ->
- match (label, expr) with
- | ( { txt = Lident "rename"; _ },
- { pexp_desc = Pexp_constant (Pconst_string (s, _, _)); _ } ) ->
- name := s;
- ()
- | { txt = Lident "default"; _ }, expr ->
- presence := `with_default expr;
- ()
- | _ -> ())
- fields
- | _ -> ()
- in
-
- (lbl, { name = !name; presence = !presence; should_skip = !should_skip })
diff --git a/derive/de.ml b/derive/de.ml
deleted file mode 100644
index def5c3a..0000000
--- a/derive/de.ml
+++ /dev/null
@@ -1,565 +0,0 @@
-open Ppxlib
-module Ast = Ast_builder.Default
-
-(** helpers *)
-let loc ~ctxt = Expansion_context.Deriver.derived_item_loc ctxt
-
-let var ~ctxt name =
- let loc = loc ~ctxt in
- Loc.make ~loc name
-
-let gensym () =
- let counter = ref 0 in
- fun ~ctxt ->
- counter := !counter + 1;
- var ~ctxt ("v_" ^ Int.to_string !counter)
-
-let deserializer_fn_name_for_longident name =
- let name =
- match name.txt |> Longident.flatten_exn |> List.rev with
- | name :: [] -> "deserialize_" ^ name
- | name :: path ->
- ("deserialize_" ^ name) :: path |> List.rev |> String.concat "."
- | _ -> "unknown"
- in
- Longident.parse name
-
-let is_primitive = function
- | "bool" | "char" | "float" | "int" | "int32" | "int64" | "string" | "list"
- | "array" | "unit" | "option" ->
- true
- | _ -> false
-
-(** [deserializer_for_type] creates a call to a deserializer based on a type.
-
- When type is a constructor (or [Ptyp_constr], which is OCaml for "any type name"),
- we will look at the number of arguments it has and
-
-*)
-let rec deserializer_for_type ~ctxt (core_type : Parsetree.core_type) =
- let loc = loc ~ctxt in
- match core_type.ptyp_desc with
- | Ptyp_constr (name, arg :: []) when is_primitive (Longident.name name.txt) ->
- let type_ser = deserializer_for_type ~ctxt arg in
- let name = Ast.pexp_ident ~loc name in
- [%expr d ([%e name] [%e type_ser])]
- | Ptyp_constr (name, []) when is_primitive (Longident.name name.txt) ->
- Ast.pexp_ident ~loc name
- | Ptyp_constr (name, _args) ->
- let ser_fn =
- deserializer_fn_name_for_longident name
- |> var ~ctxt |> Ast.pexp_ident ~loc
- in
- [%expr d [%e ser_fn]]
- | Ptyp_any | Ptyp_var _
- | Ptyp_arrow (_, _, _)
- | Ptyp_tuple _
- | Ptyp_object (_, _)
- | Ptyp_class (_, _)
- | Ptyp_alias (_, _)
- | Ptyp_variant (_, _, _)
- | Ptyp_poly (_, _)
- | Ptyp_package _ | Ptyp_extension _ ->
- failwith "unsupported"
-
-(** implementation *)
-
-(** Deserializes records in different ways. *)
-module Record_deserializer = struct
- (** Generates the implementation of a deserializer for a given record type (or
- list of label declarations).
-
- The outline of the generated code is:
-
- * create a field_visitor that maps strings and ints to an ad-hoc field
- polyvar (field name "hello" matches [`hello])
-
- * declare field value holders (one 'a option ref per field)
-
- * create a recursive function for consuimng fields one by one, using
- the visitor to validate them, and directing the deserialization to the
- right field deserializer
-
- * extract the field value holders and validate that all fields are present
-
- * construct the final result
-
- So for a record like:
-
- {ocaml[
- type person = { name: string; age: int }
- ]}
-
- The generated code would look like:
-
- {ocaml[
- let deserialize_person = De.(deserializer @@ fun ctx ->
- record ctx "person" 2 @@ fun ctx ->
- let field_visitor = Visitor.make
- ~visit_string:(fun _ctx str ->
- match str with
- | "name" -> Ok `name
- | "age" -> Ok `age
- | _ -> Error `invalid_field_type)
- ~visit_int:(fun _ctx int ->
- match int with
- | 0 -> Ok `name
- | 1 -> Ok `age
- | _ -> Error `invalid_field_type)
- ()
- in
-
- let name = ref None in
- let age = ref None in
-
- let rec read_fields () =
- let* tag = next_field ctx field_visitor in
- match tag with
- | Some `name ->
- let* v = field ctx "name" string in
- name := Some v;
- read_fields ()
- | Some `age ->
- let* v = field ctx "age" int in
- age := Some v;
- read_fields ()
- | None ->
- Ok ()
- in
- let* () = read_fields () in
-
- let* name = Option.to_result ~none:(`Msg "missing field 'name'") name in
- let* age = Option.to_result ~none:(`Msg "missing field 'age'") age in
-
- Ok {name;age}
- )
- ]}
-*)
- let deserialize_with_unordered_fields ~ctxt labels final_expr =
- let loc = loc ~ctxt in
- let labels = List.rev labels in
- let labels = List.map Attributes.of_field_attributes labels in
-
- (* NOTE(@leostera): Generate the final assembling of the record value
-
- {ocaml[
- ... in
- Ok { name; age }
- ]}
- *)
- let record_expr =
- let fields =
- List.map
- (fun (field, _) ->
- let value = Ast.evar ~loc field.pld_name.txt in
- let field = Longident.parse field.pld_name.txt |> var ~ctxt in
- (field, value))
- labels
- in
- let record = Ast.pexp_record ~loc fields None in
- final_expr record
- in
-
- (* NOTE(@leostera): Generate the placeholder values for a list of fields:
-
- {ocaml[
- let name = ref None in
- let age = ref None in
- ...
- ]}
- *)
- let field_value_holders body =
- List.fold_left
- (fun last (field, _) ->
- let field = Ast.(pvar ~loc field.pld_name.txt) in
- [%expr
- let [%p field] = ref None in
- [%e last]])
- body labels
- in
-
- (* NOTE(@leostera): Generate the placeholder values for a list of fields:
-
- {ocaml[
- let name = ref None in
- let age = ref None in
- ...
- ]}
- *)
- let field_value_unwrapping body =
- List.fold_left
- (fun last (field, attr) ->
- let field_var = Ast.(evar ~loc field.pld_name.txt) in
- let field_pat = Ast.(pvar ~loc field.pld_name.txt) in
- let missing_msg =
- Ast.estring ~loc
- (Format.sprintf "missing field %S (%S)"
- Attributes.(attr.name)
- field.pld_name.txt)
- in
- match Attributes.(attr.presence) with
- | `required ->
- [%expr
- let* [%p field_pat] =
- Option.to_result ~none:(`Msg [%e missing_msg]) ![%e field_var]
- in
- [%e last]]
- | `optional ->
- [%expr
- let [%p field_pat] =
- match ![%e field_var] with Some opt -> opt | None -> None
- in
- [%e last]]
- | `with_default str ->
- [%expr
- let [%p field_pat] =
- match ![%e field_var] with
- | Some opt -> opt
- | None -> [%e str]
- in
- [%e last]])
- body labels
- in
-
- (* NOTE(@leostera): creates the visito from strings/ints to polymorphic
- variants for each field
-
- {ocaml[
- Visitor.make
- ~visit_string:(fun _ctx str ->
- match str with
- | "name" -> Ok `name
- | "age" -> Ok `age
- | _ -> Error `invalid_field_type)
- ~visit_int:(fun _ctx int ->
- match int with
- | 0 -> Ok `name
- | 1 -> Ok `age
- | _ -> Error `invalid_field_type)
- ()
- ]}
- *)
- let field_visitor next =
- let visit_string =
- let cases =
- List.map
- (fun (field, attr) ->
- let lhs = Ast.pstring ~loc Attributes.(attr.name) in
- let rhs =
- let tag = Ast.pexp_variant ~loc field.pld_name.txt None in
- [%expr Ok [%e tag]]
- in
- Ast.case ~lhs ~rhs ~guard:None)
- labels
- @ [
- Ast.case ~lhs:(Ast.ppat_any ~loc) ~guard:None
- ~rhs:[%expr Error `invalid_tag];
- ]
- in
- let body = Ast.pexp_match ~loc [%expr str] cases in
- [%expr fun _ctx str -> [%e body]]
- in
-
- let visit_int =
- let cases =
- List.mapi
- (fun idx (field, _) ->
- let lhs = Ast.pint ~loc idx in
- let rhs =
- let tag = Ast.pexp_variant ~loc field.pld_name.txt None in
- [%expr Ok [%e tag]]
- in
- Ast.case ~lhs ~rhs ~guard:None)
- labels
- @ [
- Ast.case ~lhs:(Ast.ppat_any ~loc) ~guard:None
- ~rhs:[%expr Error `invalid_tag];
- ]
- in
- let body = Ast.pexp_match ~loc [%expr str] cases in
- [%expr fun _ctx str -> [%e body]]
- in
-
- [%expr
- let field_visitor =
- let visit_string = [%e visit_string] in
- let visit_int = [%e visit_int] in
- Visitor.make ~visit_string ~visit_int ()
- in
- [%e next]]
- in
-
- let declare_read_fields next =
- let cases =
- List.mapi
- (fun _idx (label, attrs) ->
- let lhs =
- let tag = Ast.ppat_variant ~loc label.pld_name.txt None in
- Ast.ppat_construct ~loc
- Longident.(parse "Some" |> var ~ctxt)
- (Some tag)
- in
- let rhs =
- (* let field_name = Ast.estring ~loc label.pld_name.txt in *)
- let field_name = Ast.estring ~loc Attributes.(attrs.name) in
- let field_var = Ast.(evar ~loc label.pld_name.txt) in
- let deserializer = deserializer_for_type ~ctxt label.pld_type in
- let assign =
- Ast.(
- pexp_apply ~loc
- (pexp_ident ~loc (var ~ctxt (Longident.parse ":=")))
- [ (Nolabel, field_var); (Nolabel, [%expr Some v]) ])
- in
- [%expr
- let* v = field ctx [%e field_name] [%e deserializer] in
- [%e assign];
- read_fields ()]
- in
- Ast.case ~lhs ~guard:None ~rhs)
- labels
- @ [
- Ast.case
- ~lhs:
- (Ast.ppat_construct ~loc
- Longident.(parse "None" |> var ~ctxt)
- None)
- ~guard:None ~rhs:[%expr Ok ()];
- ]
- in
-
- let tag_match = Ast.pexp_match ~loc [%expr tag] cases in
-
- [%expr
- let rec read_fields () =
- let* tag = next_field ctx field_visitor in
- [%e tag_match]
- in
- [%e next]]
- in
-
- let call_read_fields next =
- [%expr
- let* () = read_fields () in
- [%e next]]
- in
-
- field_visitor
- (* declare all the optional references *)
- @@ field_value_holders
- (* declare our recursive function for consuming fields *)
- @@ declare_read_fields
- (* here's where the magic happens *)
- @@ call_read_fields
- (* unwrap all the boxes *)
- @@ field_value_unwrapping
- (* build the record *)
- @@ record_expr
-end
-
-let gen_deserialize_variant_impl ~ctxt ptype_name cstr_declarations =
- let loc = loc ~ctxt in
- let type_name = Ast.estring ~loc ptype_name.txt in
- let constructor_names =
- Ast.elist ~loc
- (List.map
- (fun (cstr : Parsetree.constructor_declaration) ->
- Ast.estring ~loc cstr.pcd_name.txt)
- cstr_declarations)
- in
-
- let deser_by_constructor _type_name idx cstr =
- let _idx = Ast.eint ~loc idx in
- let name = Longident.parse cstr.pcd_name.txt |> var ~ctxt in
- match cstr.pcd_args with
- (* NOTE(@leostera): deserialize a single unit variant by calling
- `unit_variant` directly *)
- | Pcstr_tuple [] ->
- let value = Ast.pexp_construct ~loc name None in
- [%expr
- let* () = unit_variant ctx in
- Ok [%e value]]
- (* NOTE(@leostera): deserialize a newtype variant *)
- | Pcstr_tuple [ arg ] ->
- let sym = gensym () ~ctxt in
- let arg_pat = Ast.pvar ~loc sym.txt in
- let arg_var = Ast.evar ~loc sym.txt in
-
- let value =
- let cstr = Ast.pexp_construct ~loc name (Some arg_var) in
- [%expr Ok [%e cstr]]
- in
-
- let ser_fn = deserializer_for_type ~ctxt arg in
- let body =
- [%expr
- let* [%p arg_pat] = [%e ser_fn] ctx in
- [%e value]]
- in
-
- [%expr newtype_variant ctx @@ fun ctx -> [%e body]]
- (* NOTE(@leostera): deserialize a tuple variant *)
- | Pcstr_tuple args ->
- let gensym = gensym () in
- let arg_count = Ast.eint ~loc (List.length args) in
- let calls =
- List.mapi
- (fun _idx arg ->
- let ser_fn = deserializer_for_type ~ctxt arg in
- let arg_var = (gensym ~ctxt).txt in
- let deser =
- [%expr
- match element ctx [%e ser_fn] with
- | Ok (Some v) -> Ok v
- | Ok None -> Error `no_more_data
- | Error reason -> Error reason]
- in
-
- (arg_var, deser))
- args
- in
-
- let calls =
- let args =
- Ast.pexp_tuple ~loc
- (List.map (fun (field, _) -> Ast.evar ~loc field) calls)
- in
- let cstr = Ast.pexp_construct ~loc name (Some args) in
-
- List.fold_left
- (fun last (field, expr) ->
- let field = Ast.pvar ~loc field in
- [%expr
- let* [%p field] = [%e expr] in
- [%e last]])
- [%expr Ok [%e cstr]]
- (List.rev calls)
- in
- [%expr
- tuple_variant ctx [%e arg_count] (fun ~size ctx ->
- ignore size;
- [%e calls])]
- (* NOTE(@leostera): deserialize a record_variant *)
- | Pcstr_record labels ->
- let field_count = Ast.eint ~loc (List.length labels) in
- let body =
- Record_deserializer.deserialize_with_unordered_fields ~ctxt labels
- @@ fun record ->
- let cstr = Ast.pexp_construct ~loc name (Some record) in
- [%expr Ok [%e cstr]]
- in
-
- [%expr
- record_variant ctx [%e field_count] (fun ~size ctx ->
- ignore size;
- [%e body])]
- in
-
- let tag_dispatch =
- let cases =
- List.mapi
- (fun idx (cstr : Parsetree.constructor_declaration) ->
- let lhs = Ast.ppat_variant ~loc cstr.pcd_name.txt None in
- let rhs = deser_by_constructor type_name idx cstr in
- Ast.case ~lhs ~guard:None ~rhs)
- cstr_declarations
- in
-
- Ast.pexp_match ~loc [%expr tag] cases
- in
-
- let field_visitor =
- let cases =
- List.mapi
- (fun _idx (cstr : Parsetree.constructor_declaration) ->
- let tag_name = cstr.pcd_name.txt in
- let lhs = Ast.ppat_constant ~loc (Ast_helper.Const.string tag_name) in
- let rhs =
- let tag = Ast.pexp_variant ~loc cstr.pcd_name.txt None in
- [%expr Ok [%e tag]]
- in
- Ast.case ~lhs ~guard:None ~rhs)
- cstr_declarations
- @ [
- Ast.case ~lhs:(Ast.ppat_any ~loc) ~guard:None
- ~rhs:[%expr Error `invalid_tag];
- ]
- in
-
- let tag_match = Ast.pexp_match ~loc [%expr str] cases in
-
- [%expr Visitor.make ~visit_string:(fun _ctx str -> [%e tag_match]) ()]
- in
-
- [%expr
- let field_visitor = [%e field_visitor] in
- variant ctx [%e type_name] [%e constructor_names] @@ fun ctx ->
- let* tag = identifier ctx field_visitor in
- [%e tag_dispatch]]
-
-(** Generate the deserializer function for a record type.
-
- See [Record_deserializer] above for more info.
-*)
-let gen_deserialize_record_impl ~ctxt ptype_name label_declarations =
- let loc = loc ~ctxt in
- let type_name = Ast.estring ~loc ptype_name.txt in
- let field_count = Ast.eint ~loc (List.length label_declarations) in
-
- let body =
- Record_deserializer.deserialize_with_unordered_fields ~ctxt
- label_declarations
- @@ fun record -> [%expr Ok [%e record]]
- in
-
- [%expr record ctx [%e type_name] [%e field_count] (fun ctx -> [%e body])]
-
-(** Generates a deserializer implementation dispatching based on the kind of
- type that the [@@deriving] attribute was set on.
-*)
-let gen_deserialize_impl ~ctxt type_decl =
- let loc = loc ~ctxt in
-
- let typename = type_decl.ptype_name.txt in
-
- let body =
- match type_decl with
- | { ptype_kind = Ptype_record label_declarations; ptype_name; _ } ->
- gen_deserialize_record_impl ~ctxt ptype_name label_declarations
- | { ptype_kind = Ptype_variant cstrs_declaration; ptype_name; _ } ->
- gen_deserialize_variant_impl ~ctxt ptype_name cstrs_declaration
- | { ptype_kind; ptype_name; _ } ->
- let err =
- match ptype_kind with
- | Ptype_abstract -> "unsupported abstract type"
- | Ptype_variant _ -> "unsupported variant type"
- | Ptype_record _ -> "unsupported record type"
- | Ptype_open -> "unsupported open type"
- in
- [%expr
- [%e ptype_name.txt |> Ast.estring ~loc] [%e err |> Ast.estring ~loc]]
- in
- let deserializer_name =
- "deserialize_" ^ typename |> var ~ctxt |> Ast.ppat_var ~loc
- in
- [%stri
- let [%p deserializer_name] =
- let ( let* ) = Result.bind in
- Serde.De.(fun ctx -> [%e body])]
-
-let generate_impl ~ctxt (_rec_flag, type_declarations) =
- let loc = loc ~ctxt in
- [ [%stri open! Serde]; [%stri let ( let* ) = Result.bind] ]
- @ List.map (gen_deserialize_impl ~ctxt) type_declarations
-
-let impl_generator = Deriving.Generator.V2.make_noarg generate_impl
-
-(** interface *)
-
-let generate_intf ~ctxt:_ (_rec_flag, _type_declarations) = []
-let intf_generator = Deriving.Generator.V2.make_noarg generate_intf
-
-(** registration *)
-
-let register =
- Deriving.add "deserialize" ~str_type_decl:impl_generator
- ~sig_type_decl:intf_generator
diff --git a/derive/dune b/derive/dune
deleted file mode 100644
index 80b33ed..0000000
--- a/derive/dune
+++ /dev/null
@@ -1,12 +0,0 @@
-(library
- (public_name serde_derive)
- (kind ppx_rewriter)
- (libraries compiler-libs ppxlib serde)
- (preprocess
- (pps ppxlib.metaquot)))
-
-(cram
- (deps
- (package serde)
- (package serde_derive)
- (package serde_json)))
diff --git a/derive/ppx.t/.ocamlformat b/derive/ppx.t/.ocamlformat
deleted file mode 100644
index e69de29..0000000
diff --git a/derive/ppx.t/dune b/derive/ppx.t/dune
deleted file mode 100644
index 874926f..0000000
--- a/derive/ppx.t/dune
+++ /dev/null
@@ -1,11 +0,0 @@
-(executable
- (name record_test)
- (modules record_test)
- (preprocess (pps serde_derive))
- (libraries serde serde_json))
-
-(executable
- (name variant_test)
- (modules variant_test)
- (preprocess (pps serde_derive))
- (libraries serde serde_json))
diff --git a/derive/ppx.t/dune-project b/derive/ppx.t/dune-project
deleted file mode 100644
index cac3ad3..0000000
--- a/derive/ppx.t/dune-project
+++ /dev/null
@@ -1 +0,0 @@
-(lang dune 3.12)
diff --git a/derive/ppx.t/ppx_test.ml b/derive/ppx.t/ppx_test.ml
deleted file mode 100644
index 1265a86..0000000
--- a/derive/ppx.t/ppx_test.ml
+++ /dev/null
@@ -1,45 +0,0 @@
-type rank = {
- rank_scores : string list;
- rank_name : string;
-}
-[@@deriving serializer, deserializer]
-
-type t = {
- name : string;
- commisioned : bool;
- updated_at: int64;
- credits: int32 option;
- keywords: string array;
- rank: rank
-}
-[@@deriving serializer, deserializer]
-
-type t_list = { stuff : t list }
-[@@deriving serializer, deserializer]
-
-let () =
- let test_t = {
- stuff = [
- {
- name = "hello";
- commisioned = false;
- updated_at = Int64.(sub max_int 1L);
- credits = None;
- keywords = [||];
- rank = { rank_name = "asdf"; rank_scores = ["1";"c";"a"]}
- };
- {
- name = "hello";
- commisioned = false;
- updated_at = 0L;
- credits = Some 2112l;
- keywords = [|"hello"|];
- rank = { rank_name = "asdf"; rank_scores = []}
- }
- ]
- }
- in
- let json1 = Serde_json.to_string serialize_t_list test_t |> Result.get_ok in
- let value = Serde_json.of_string deserialize_t_list json1 |> Result.get_ok in
- let json2 = Serde_json.to_string serialize_t_list value |> Result.get_ok in
- Format.printf "[%s,%s]\n%!" json1 json2
diff --git a/derive/ppx.t/record_test.ml b/derive/ppx.t/record_test.ml
deleted file mode 100644
index 2b6475a..0000000
--- a/derive/ppx.t/record_test.ml
+++ /dev/null
@@ -1,49 +0,0 @@
-type rank = { rank_scores : string list; rank_name : string }
-[@@deriving serialize, deserialize]
-
-type t = {
- name : string;
- commisioned : bool;
- updated_at : int64;
- credits : int32 option;
- keywords : string array;
- rank : rank;
- value : float;
- type_ : string; [@serde { rename = "type" }]
-}
-[@@deriving serialize, deserialize]
-
-type t_list = { stuff : t list } [@@deriving serialize, deserialize]
-
-let () =
- let test_t =
- {
- stuff =
- [
- {
- name = "hello";
- commisioned = false;
- updated_at = 9223372036854766L;
- credits = None;
- keywords = [||];
- rank = { rank_name = "asdf"; rank_scores = [ "1"; "c"; "a" ] };
- value = 420.69;
- type_ = "something";
- };
- {
- name = "hello";
- commisioned = false;
- updated_at = 0L;
- credits = Some 2112l;
- keywords = [| "hello" |];
- rank = { rank_name = "asdf"; rank_scores = [] };
- value = Float.pi;
- type_ = "something";
- };
- ];
- }
- in
- let json1 = Serde_json.to_string serialize_t_list test_t |> Result.get_ok in
- let value = Serde_json.of_string deserialize_t_list json1 |> Result.get_ok in
- let json2 = Serde_json.to_string serialize_t_list value |> Result.get_ok in
- Format.printf "[%s,%s]\n%!" json1 json2
diff --git a/derive/ppx.t/run.t b/derive/ppx.t/run.t
deleted file mode 100644
index 5256f77..0000000
--- a/derive/ppx.t/run.t
+++ /dev/null
@@ -1,678 +0,0 @@
- $ dune clean
- $ dune exec ./record_test.exe | jq .
- [
- {
- "stuff": [
- {
- "name": "hello",
- "commisioned": false,
- "updated_at": 9223372036854766,
- "credits": null,
- "keywords": [],
- "rank": {
- "rank_scores": [
- "1",
- "c",
- "a"
- ],
- "rank_name": "asdf"
- },
- "value": 420.69,
- "type": "something"
- },
- {
- "name": "hello",
- "commisioned": false,
- "updated_at": 0,
- "credits": 2112,
- "keywords": [
- "hello"
- ],
- "rank": {
- "rank_scores": [],
- "rank_name": "asdf"
- },
- "value": 3.14159265359,
- "type": "something"
- }
- ]
- },
- {
- "stuff": [
- {
- "name": "hello",
- "commisioned": false,
- "updated_at": 9223372036854766,
- "credits": null,
- "keywords": [],
- "rank": {
- "rank_scores": [
- "1",
- "c",
- "a"
- ],
- "rank_name": "asdf"
- },
- "value": 420.69,
- "type": "something"
- },
- {
- "name": "hello",
- "commisioned": false,
- "updated_at": 0,
- "credits": 2112,
- "keywords": [
- "hello"
- ],
- "rank": {
- "rank_scores": [],
- "rank_name": "asdf"
- },
- "value": 3.14159265359,
- "type": "something"
- }
- ]
- }
- ]
- $ dune describe pp ./record_test.ml
- [@@@ocaml.ppx.context
- {
- tool_name = "ppx_driver";
- include_dirs = [];
- load_path = [];
- open_modules = [];
- for_package = None;
- debug = false;
- use_threads = false;
- use_vmthreads = false;
- recursive_types = false;
- principal = false;
- transparent_modules = false;
- unboxed_types = false;
- unsafe_string = false;
- cookies = []
- }]
- type rank = {
- rank_scores: string list ;
- rank_name: string }[@@deriving (serialize, deserialize)]
- include
- struct
- let _ = fun (_ : rank) -> ()
- let ( let* ) = Result.bind
- let _ = ( let* )
- let serialize_rank =
- let open Serde.Ser in
- fun t ->
- fun ctx ->
- record ctx "rank" 2
- (fun ctx ->
- let* () =
- field ctx "rank_scores" ((s (list string)) t.rank_scores)
- in
- let* () = field ctx "rank_name" (string t.rank_name)
- in Ok ())
- let _ = serialize_rank
- open! Serde
- let ( let* ) = Result.bind
- let _ = ( let* )
- let deserialize_rank =
- let ( let* ) = Result.bind in
- let open Serde.De in
- fun ctx ->
- record ctx "rank" 2
- (fun ctx ->
- let field_visitor =
- let visit_string _ctx str =
- match str with
- | "rank_name" -> Ok `rank_name
- | "rank_scores" -> Ok `rank_scores
- | _ -> Error `invalid_tag in
- let visit_int _ctx str =
- match str with
- | 0 -> Ok `rank_name
- | 1 -> Ok `rank_scores
- | _ -> Error `invalid_tag in
- Visitor.make ~visit_string ~visit_int () in
- let rank_scores = ref None in
- let rank_name = ref None in
- let rec read_fields () =
- let* tag = next_field ctx field_visitor
- in
- match tag with
- | Some `rank_name ->
- let* v = field ctx "rank_name" string
- in (rank_name := (Some v); read_fields ())
- | Some `rank_scores ->
- let* v = field ctx "rank_scores" (d (list string))
- in (rank_scores := (Some v); read_fields ())
- | None -> Ok () in
- let* () = read_fields ()
- in
- let* rank_scores =
- Option.to_result
- ~none:(`Msg
- "missing field \"rank_scores\" (\"rank_scores\")")
- (!rank_scores)
- in
- let* rank_name =
- Option.to_result
- ~none:(`Msg "missing field \"rank_name\" (\"rank_name\")")
- (!rank_name)
- in Ok { rank_name; rank_scores })
- let _ = deserialize_rank
- end[@@ocaml.doc "@inline"][@@merlin.hide ]
- type t =
- {
- name: string ;
- commisioned: bool ;
- updated_at: int64 ;
- credits: int32 option ;
- keywords: string array ;
- rank: rank ;
- value: float ;
- type_: string [@serde { rename = "type" }]}[@@deriving
- (serialize, deserialize)]
- include
- struct
- let _ = fun (_ : t) -> ()
- let ( let* ) = Result.bind
- let _ = ( let* )
- let serialize_t =
- let open Serde.Ser in
- fun t ->
- fun ctx ->
- record ctx "t" 8
- (fun ctx ->
- let* () = field ctx "name" (string t.name)
- in
- let* () = field ctx "commisioned" (bool t.commisioned)
- in
- let* () = field ctx "updated_at" (int64 t.updated_at)
- in
- let* () = field ctx "credits" ((s (option int32)) t.credits)
- in
- let* () =
- field ctx "keywords" ((s (array string)) t.keywords)
- in
- let* () = field ctx "rank" ((s serialize_rank) t.rank)
- in
- let* () = field ctx "value" (float t.value)
- in let* () = field ctx "type" (string t.type_)
- in Ok ())
- let _ = serialize_t
- open! Serde
- let ( let* ) = Result.bind
- let _ = ( let* )
- let deserialize_t =
- let ( let* ) = Result.bind in
- let open Serde.De in
- fun ctx ->
- record ctx "t" 8
- (fun ctx ->
- let field_visitor =
- let visit_string _ctx str =
- match str with
- | "type" -> Ok `type_
- | "value" -> Ok `value
- | "rank" -> Ok `rank
- | "keywords" -> Ok `keywords
- | "credits" -> Ok `credits
- | "updated_at" -> Ok `updated_at
- | "commisioned" -> Ok `commisioned
- | "name" -> Ok `name
- | _ -> Error `invalid_tag in
- let visit_int _ctx str =
- match str with
- | 0 -> Ok `type_
- | 1 -> Ok `value
- | 2 -> Ok `rank
- | 3 -> Ok `keywords
- | 4 -> Ok `credits
- | 5 -> Ok `updated_at
- | 6 -> Ok `commisioned
- | 7 -> Ok `name
- | _ -> Error `invalid_tag in
- Visitor.make ~visit_string ~visit_int () in
- let name = ref None in
- let commisioned = ref None in
- let updated_at = ref None in
- let credits = ref None in
- let keywords = ref None in
- let rank = ref None in
- let value = ref None in
- let type_ = ref None in
- let rec read_fields () =
- let* tag = next_field ctx field_visitor
- in
- match tag with
- | Some `type_ ->
- let* v = field ctx "type" string
- in (type_ := (Some v); read_fields ())
- | Some `value ->
- let* v = field ctx "value" float
- in (value := (Some v); read_fields ())
- | Some `rank ->
- let* v = field ctx "rank" (d deserialize_rank)
- in (rank := (Some v); read_fields ())
- | Some `keywords ->
- let* v = field ctx "keywords" (d (array string))
- in (keywords := (Some v); read_fields ())
- | Some `credits ->
- let* v = field ctx "credits" (d (option int32))
- in (credits := (Some v); read_fields ())
- | Some `updated_at ->
- let* v = field ctx "updated_at" int64
- in (updated_at := (Some v); read_fields ())
- | Some `commisioned ->
- let* v = field ctx "commisioned" bool
- in (commisioned := (Some v); read_fields ())
- | Some `name ->
- let* v = field ctx "name" string
- in (name := (Some v); read_fields ())
- | None -> Ok () in
- let* () = read_fields ()
- in
- let* name =
- Option.to_result
- ~none:(`Msg "missing field \"name\" (\"name\")") (
- !name)
- in
- let* commisioned =
- Option.to_result
- ~none:(`Msg
- "missing field \"commisioned\" (\"commisioned\")")
- (!commisioned)
- in
- let* updated_at =
- Option.to_result
- ~none:(`Msg
- "missing field \"updated_at\" (\"updated_at\")")
- (!updated_at)
- in
- let credits =
- match !credits with | Some opt -> opt | None -> None in
- let* keywords =
- Option.to_result
- ~none:(`Msg "missing field \"keywords\" (\"keywords\")")
- (!keywords)
- in
- let* rank =
- Option.to_result
- ~none:(`Msg "missing field \"rank\" (\"rank\")") (
- !rank)
- in
- let* value =
- Option.to_result
- ~none:(`Msg "missing field \"value\" (\"value\")")
- (!value)
- in
- let* type_ =
- Option.to_result
- ~none:(`Msg "missing field \"type\" (\"type_\")") (
- !type_)
- in
- Ok
- {
- type_;
- value;
- rank;
- keywords;
- credits;
- updated_at;
- commisioned;
- name
- })
- let _ = deserialize_t
- end[@@ocaml.doc "@inline"][@@merlin.hide ]
- type t_list = {
- stuff: t list }[@@deriving (serialize, deserialize)]
- include
- struct
- let _ = fun (_ : t_list) -> ()
- let ( let* ) = Result.bind
- let _ = ( let* )
- let serialize_t_list =
- let open Serde.Ser in
- fun t ->
- fun ctx ->
- record ctx "t_list" 1
- (fun ctx ->
- let* () =
- field ctx "stuff" ((s (list (s serialize_t))) t.stuff)
- in Ok ())
- let _ = serialize_t_list
- open! Serde
- let ( let* ) = Result.bind
- let _ = ( let* )
- let deserialize_t_list =
- let ( let* ) = Result.bind in
- let open Serde.De in
- fun ctx ->
- record ctx "t_list" 1
- (fun ctx ->
- let field_visitor =
- let visit_string _ctx str =
- match str with
- | "stuff" -> Ok `stuff
- | _ -> Error `invalid_tag in
- let visit_int _ctx str =
- match str with | 0 -> Ok `stuff | _ -> Error `invalid_tag in
- Visitor.make ~visit_string ~visit_int () in
- let stuff = ref None in
- let rec read_fields () =
- let* tag = next_field ctx field_visitor
- in
- match tag with
- | Some `stuff ->
- let* v = field ctx "stuff" (d (list (d deserialize_t)))
- in (stuff := (Some v); read_fields ())
- | None -> Ok () in
- let* () = read_fields ()
- in
- let* stuff =
- Option.to_result
- ~none:(`Msg "missing field \"stuff\" (\"stuff\")")
- (!stuff)
- in Ok { stuff })
- let _ = deserialize_t_list
- end[@@ocaml.doc "@inline"][@@merlin.hide ]
- let () =
- let test_t =
- {
- stuff =
- [{
- name = "hello";
- commisioned = false;
- updated_at = 9223372036854766L;
- credits = None;
- keywords = [||];
- rank = { rank_name = "asdf"; rank_scores = ["1"; "c"; "a"] };
- value = 420.69;
- type_ = "something"
- };
- {
- name = "hello";
- commisioned = false;
- updated_at = 0L;
- credits = (Some 2112l);
- keywords = [|"hello"|];
- rank = { rank_name = "asdf"; rank_scores = [] };
- value = Float.pi;
- type_ = "something"
- }]
- } in
- let json1 = (Serde_json.to_string serialize_t_list test_t) |> Result.get_ok in
- let value =
- (Serde_json.of_string deserialize_t_list json1) |> Result.get_ok in
- let json2 = (Serde_json.to_string serialize_t_list value) |> Result.get_ok in
- Format.printf "[%s,%s]\n%!" json1 json2
-
-
-
-
-Now we test the variants:
-
- $ dune exec ./variant_test.exe | jq .
- [
- {
- "Ranks": [
- "Ensign",
- {
- "Commander": [
- "riker",
- 2112,
- 3.14159265359
- ]
- },
- {
- "Lt": null
- },
- {
- "Lt": false
- },
- {
- "Lt": true
- },
- {
- "Captain": {
- "name": "janeway",
- "ship": "voyager"
- }
- }
- ]
- },
- {
- "Ranks": [
- "Ensign",
- {
- "Commander": [
- "riker",
- 2112,
- 3.14159265359
- ]
- },
- {
- "Lt": null
- },
- {
- "Lt": false
- },
- {
- "Lt": true
- },
- {
- "Captain": {
- "name": "janeway",
- "ship": "voyager"
- }
- }
- ]
- }
- ]
- $ dune describe pp ./variant_test.ml
- [@@@ocaml.ppx.context
- {
- tool_name = "ppx_driver";
- include_dirs = [];
- load_path = [];
- open_modules = [];
- for_package = None;
- debug = false;
- use_threads = false;
- use_vmthreads = false;
- recursive_types = false;
- principal = false;
- transparent_modules = false;
- unboxed_types = false;
- unsafe_string = false;
- cookies = []
- }]
- [@@@warning "-37"]
- type rank =
- | Captain of {
- name: string ;
- ship: string }
- | Commander of string * int32 * float
- | Lt of bool option
- | Ensign [@@deriving (serialize, deserialize)]
- include
- struct
- let _ = fun (_ : rank) -> ()
- let ( let* ) = Result.bind
- let _ = ( let* )
- let serialize_rank =
- let open Serde.Ser in
- fun t ->
- fun ctx ->
- match t with
- | Captain r ->
- record_variant ctx "rank" 0 "Captain" 2
- (fun ctx ->
- let* () = field ctx "name" (string r.name)
- in let* () = field ctx "ship" (string r.ship)
- in Ok ())
- | Commander (v_1, v_2, v_3) ->
- tuple_variant ctx "rank" 1 "Commander" 3
- (fun ctx ->
- let* () = element ctx (string v_1)
- in
- let* () = element ctx (int32 v_2)
- in let* () = element ctx (float v_3)
- in Ok ())
- | Lt v_1 ->
- newtype_variant ctx "rank" 2 "Lt" ((s (option bool)) v_1)
- | Ensign -> unit_variant ctx "rank" 3 "Ensign"
- let _ = serialize_rank
- open! Serde
- let ( let* ) = Result.bind
- let _ = ( let* )
- let deserialize_rank =
- let ( let* ) = Result.bind in
- let open Serde.De in
- fun ctx ->
- let field_visitor =
- Visitor.make
- ~visit_string:(fun _ctx ->
- fun str ->
- match str with
- | "Captain" -> Ok `Captain
- | "Commander" -> Ok `Commander
- | "Lt" -> Ok `Lt
- | "Ensign" -> Ok `Ensign
- | _ -> Error `invalid_tag) () in
- (variant ctx "rank" ["Captain"; "Commander"; "Lt"; "Ensign"]) @@
- (fun ctx ->
- let* tag = identifier ctx field_visitor
- in
- match tag with
- | `Captain ->
- record_variant ctx 2
- (fun ~size ->
- fun ctx ->
- ignore size;
- (let field_visitor =
- let visit_string _ctx str =
- match str with
- | "ship" -> Ok `ship
- | "name" -> Ok `name
- | _ -> Error `invalid_tag in
- let visit_int _ctx str =
- match str with
- | 0 -> Ok `ship
- | 1 -> Ok `name
- | _ -> Error `invalid_tag in
- Visitor.make ~visit_string ~visit_int () in
- let name = ref None in
- let ship = ref None in
- let rec read_fields () =
- let* tag = next_field ctx field_visitor
- in
- match tag with
- | Some `ship ->
- let* v = field ctx "ship" string
- in (ship := (Some v); read_fields ())
- | Some `name ->
- let* v = field ctx "name" string
- in (name := (Some v); read_fields ())
- | None -> Ok () in
- let* () = read_fields ()
- in
- let* name =
- Option.to_result
- ~none:(`Msg
- "missing field \"name\" (\"name\")")
- (!name)
- in
- let* ship =
- Option.to_result
- ~none:(`Msg
- "missing field \"ship\" (\"ship\")")
- (!ship)
- in Ok (Captain { ship; name })))
- | `Commander ->
- tuple_variant ctx 3
- (fun ~size ->
- fun ctx ->
- ignore size;
- (let* v_1 =
- match element ctx string with
- | Ok (Some v) -> Ok v
- | Ok (None) -> Error `no_more_data
- | Error reason -> Error reason
- in
- let* v_2 =
- match element ctx int32 with
- | Ok (Some v) -> Ok v
- | Ok (None) -> Error `no_more_data
- | Error reason -> Error reason
- in
- let* v_3 =
- match element ctx float with
- | Ok (Some v) -> Ok v
- | Ok (None) -> Error `no_more_data
- | Error reason -> Error reason
- in Ok (Commander (v_1, v_2, v_3))))
- | `Lt ->
- (newtype_variant ctx) @@
- ((fun ctx ->
- let* v_1 = (d (option bool)) ctx
- in Ok (Lt v_1)))
- | `Ensign -> let* () = unit_variant ctx
- in Ok Ensign)
- let _ = deserialize_rank
- end[@@ocaml.doc "@inline"][@@merlin.hide ]
- type ranks =
- | Ranks of rank list [@@deriving (serialize, deserialize)]
- include
- struct
- let _ = fun (_ : ranks) -> ()
- let ( let* ) = Result.bind
- let _ = ( let* )
- let serialize_ranks =
- let open Serde.Ser in
- fun t ->
- fun ctx ->
- match t with
- | Ranks v_1 ->
- newtype_variant ctx "ranks" 0 "Ranks"
- ((s (list (s serialize_rank))) v_1)
- let _ = serialize_ranks
- open! Serde
- let ( let* ) = Result.bind
- let _ = ( let* )
- let deserialize_ranks =
- let ( let* ) = Result.bind in
- let open Serde.De in
- fun ctx ->
- let field_visitor =
- Visitor.make
- ~visit_string:(fun _ctx ->
- fun str ->
- match str with
- | "Ranks" -> Ok `Ranks
- | _ -> Error `invalid_tag) () in
- (variant ctx "ranks" ["Ranks"]) @@
- (fun ctx ->
- let* tag = identifier ctx field_visitor
- in
- match tag with
- | `Ranks ->
- (newtype_variant ctx) @@
- ((fun ctx ->
- let* v_1 = (d (list (d deserialize_rank))) ctx
- in Ok (Ranks v_1))))
- let _ = deserialize_ranks
- end[@@ocaml.doc "@inline"][@@merlin.hide ]
- let () =
- let test_t =
- Ranks
- [Ensign;
- Commander ("riker", 2112l, Float.pi);
- Lt None;
- Lt (Some false);
- Lt (Some true);
- Captain { name = "janeway"; ship = "voyager" }] in
- let json1 = (Serde_json.to_string serialize_ranks test_t) |> Result.get_ok in
- let value = (Serde_json.of_string deserialize_ranks json1) |> Result.get_ok in
- let json2 = (Serde_json.to_string serialize_ranks value) |> Result.get_ok in
- Format.printf "[%s,%s]\n%!" json1 json2
diff --git a/derive/ppx.t/variant_test.ml b/derive/ppx.t/variant_test.ml
deleted file mode 100644
index 1525360..0000000
--- a/derive/ppx.t/variant_test.ml
+++ /dev/null
@@ -1,28 +0,0 @@
-[@@@warning "-37"]
-
-type rank =
- | Captain of { name : string; ship : string }
- | Commander of string * int32 * float
- | Lt of bool option
- | Ensign
-[@@deriving serialize, deserialize]
-
-type ranks = Ranks of rank list [@@deriving serialize, deserialize]
-
-let () =
- let test_t =
- Ranks
- [
- Ensign;
- Commander ("riker", 2112l, Float.pi);
- Lt None;
- Lt (Some false);
- Lt (Some true);
- Captain { name = "janeway"; ship = "voyager" };
- ]
- in
- let json1 = Serde_json.to_string serialize_ranks test_t |> Result.get_ok in
- (* Format.printf "%s\n%!" json1 *)
- let value = Serde_json.of_string deserialize_ranks json1 |> Result.get_ok in
- let json2 = Serde_json.to_string serialize_ranks value |> Result.get_ok in
- Format.printf "[%s,%s]\n%!" json1 json2
diff --git a/derive/ser.ml b/derive/ser.ml
deleted file mode 100644
index 47cff7c..0000000
--- a/derive/ser.ml
+++ /dev/null
@@ -1,227 +0,0 @@
-open Ppxlib
-module Ast = Ast_builder.Default
-
-(** helpers *)
-let loc ~ctxt = Expansion_context.Deriver.derived_item_loc ctxt
-
-let var ~ctxt name =
- let loc = loc ~ctxt in
- Loc.make ~loc name
-
-let gensym () =
- let counter = ref 0 in
- fun ~ctxt ->
- counter := !counter + 1;
- var ~ctxt ("v_" ^ Int.to_string !counter)
-
-let serializer_fn_name_for_longident name =
- let name =
- match name.txt |> Longident.flatten_exn |> List.rev with
- | name :: [] -> "serialize_" ^ name
- | name :: path ->
- ("serialize_" ^ name) :: path |> List.rev |> String.concat "."
- | _ -> "unknown"
- in
- Longident.parse name
-
-let is_primitive = function
- | "bool" | "char" | "float" | "int" | "int32" | "int64" | "string" | "list"
- | "array" | "unit" | "option" ->
- true
- | _ -> false
-
-let rec serializer_for_type ~ctxt (core_type : Parsetree.core_type) =
- let loc = loc ~ctxt in
- match core_type.ptyp_desc with
- | Ptyp_constr (name, arg :: []) when is_primitive (Longident.name name.txt) ->
- let type_ser = serializer_for_type ~ctxt arg in
- let name = Ast.pexp_ident ~loc name in
- [%expr s ([%e name] [%e type_ser])]
- | Ptyp_constr (name, []) when is_primitive (Longident.name name.txt) ->
- Ast.pexp_ident ~loc name
- | Ptyp_constr (name, _args) ->
- let ser_fn =
- serializer_fn_name_for_longident name
- |> var ~ctxt |> Ast.pexp_ident ~loc
- in
- [%expr s [%e ser_fn]]
- | Ptyp_any | Ptyp_var _
- | Ptyp_arrow (_, _, _)
- | Ptyp_tuple _
- | Ptyp_object (_, _)
- | Ptyp_class (_, _)
- | Ptyp_alias (_, _)
- | Ptyp_variant (_, _, _)
- | Ptyp_poly (_, _)
- | Ptyp_package _ | Ptyp_extension _ ->
- failwith "unsupported"
-
-(** implementation *)
-
-let gen_serialize_variant_impl ~ctxt ptype_name cstr_declarations =
- let loc = loc ~ctxt in
- let type_name = Ast.estring ~loc ptype_name.txt in
-
- let pattern_of_constructor cstr =
- match cstr.pcd_args with
- | Pcstr_tuple [] -> None
- | Pcstr_tuple parts ->
- let gensym = gensym () in
- Some
- (Ast.ppat_tuple ~loc
- (List.map (fun _ -> Ast.pvar ~loc (gensym ~ctxt).txt) parts))
- | Pcstr_record _ -> Some (Ast.pvar ~loc "r")
- in
-
- let ser_by_constructor type_name idx cstr =
- let idx = Ast.eint ~loc idx in
- let name = Ast.estring ~loc cstr.pcd_name.txt in
- match cstr.pcd_args with
- | Pcstr_tuple [] ->
- [%expr unit_variant ctx [%e type_name] [%e idx] [%e name]]
- | Pcstr_tuple [ arg ] ->
- let ser_fn = serializer_for_type ~ctxt arg in
- let arg_var = Ast.evar ~loc (gensym () ~ctxt).txt in
- let ser = [%expr [%e ser_fn] [%e arg_var]] in
- [%expr newtype_variant ctx [%e type_name] [%e idx] [%e name] [%e ser]]
- | Pcstr_tuple args ->
- let arg_count = Ast.eint ~loc (List.length args) in
- let gensym = gensym () in
- let calls =
- List.mapi
- (fun _idx arg ->
- let ser_fn = serializer_for_type ~ctxt arg in
- let arg_var = Ast.evar ~loc (gensym ~ctxt).txt in
- [%expr element ctx ([%e ser_fn] [%e arg_var])])
- args
- in
-
- let calls =
- List.fold_left
- (fun last expr ->
- [%expr
- let* () = [%e expr] in
- [%e last]])
- [%expr Ok ()] (List.rev calls)
- in
- [%expr
- tuple_variant ctx [%e type_name] [%e idx] [%e name] [%e arg_count]
- (fun ctx -> [%e calls])]
- | Pcstr_record labels ->
- let field_count = Ast.eint ~loc (List.length labels) in
- let labels = List.rev labels in
- let labels = List.map Attributes.of_field_attributes labels in
- let fields =
- List.map
- (fun (field, attr) ->
- let field_name = Ast.estring ~loc Attributes.(attr.name) in
- let field_access =
- let field_name = Longident.parse field.pld_name.txt in
- Ast.pexp_field ~loc (Ast.evar ~loc "r")
- (Loc.make ~loc field_name)
- in
- let serializer = serializer_for_type ~ctxt field.pld_type in
- [%expr
- field ctx [%e field_name] ([%e serializer] [%e field_access])])
- labels
- in
- let fields =
- List.fold_left
- (fun last curr ->
- [%expr
- let* () = [%e curr] in
- [%e last]])
- [%expr Ok ()] fields
- in
-
- [%expr
- record_variant ctx [%e type_name] [%e idx] [%e name] [%e field_count]
- (fun ctx -> [%e fields])]
- in
-
- let cases =
- List.mapi
- (fun idx (cstr : Parsetree.constructor_declaration) ->
- let lhs = Ast.pconstruct cstr (pattern_of_constructor cstr) in
- let rhs = ser_by_constructor type_name idx cstr in
- Ast.case ~lhs ~guard:None ~rhs)
- cstr_declarations
- in
-
- Ast.pexp_match ~loc [%expr t] cases
-
-let gen_serialize_record_impl ~ctxt ptype_name label_declarations =
- let loc = loc ~ctxt in
- let type_name = Ast.estring ~loc ptype_name.txt in
- let field_count = Ast.eint ~loc (List.length label_declarations) in
- let labels = List.rev label_declarations in
- let labels = List.map Attributes.of_field_attributes labels in
-
- let fields =
- List.map
- (fun (field, attr) ->
- let field_name = Ast.estring ~loc Attributes.(attr.name) in
- let field_access =
- let field_name = Longident.parse field.pld_name.txt in
- Ast.pexp_field ~loc (Ast.evar ~loc "t") (Loc.make ~loc field_name)
- in
- let serializer = serializer_for_type ~ctxt field.pld_type in
- [%expr field ctx [%e field_name] ([%e serializer] [%e field_access])])
- labels
- in
-
- let fields =
- List.fold_left
- (fun last curr ->
- [%expr
- let* () = [%e curr] in
- [%e last]])
- [%expr Ok ()] fields
- in
-
- [%expr record ctx [%e type_name] [%e field_count] (fun ctx -> [%e fields])]
-
-let gen_serialize_impl ~ctxt type_decl =
- let loc = loc ~ctxt in
-
- let typename = type_decl.ptype_name.txt in
-
- let body =
- match type_decl with
- | { ptype_kind = Ptype_record label_declarations; ptype_name; _ } ->
- gen_serialize_record_impl ~ctxt ptype_name label_declarations
- | { ptype_kind = Ptype_variant cstrs_declaration; ptype_name; _ } ->
- gen_serialize_variant_impl ~ctxt ptype_name cstrs_declaration
- | { ptype_kind; ptype_name; _ } ->
- let err =
- match ptype_kind with
- | Ptype_abstract -> "unsupported abstract type"
- | Ptype_variant _ -> "unsupported variant type"
- | Ptype_record _ -> "unsupported record type"
- | Ptype_open -> "unsupported open type"
- in
- [%expr
- [%e ptype_name.txt |> Ast.estring ~loc] [%e err |> Ast.estring ~loc]]
- in
- let serializer_name =
- "serialize_" ^ typename |> var ~ctxt |> Ast.ppat_var ~loc
- in
- [%stri let [%p serializer_name] = Serde.Ser.(fun t ctx -> [%e body])]
-
-let generate_impl ~ctxt (_rec_flag, type_declarations) =
- let loc = loc ~ctxt in
- [ [%stri let ( let* ) = Result.bind] ]
- @ List.map (gen_serialize_impl ~ctxt) type_declarations
-
-let impl_generator = Deriving.Generator.V2.make_noarg generate_impl
-
-(** interface *)
-
-let generate_intf ~ctxt:_ (_rec_flag, _type_declarations) = []
-let intf_generator = Deriving.Generator.V2.make_noarg generate_intf
-
-(** registration *)
-
-let register =
- Deriving.add "serialize" ~str_type_decl:impl_generator
- ~sig_type_decl:intf_generator
diff --git a/dune-project b/dune-project
index 8419cff..3d0725d 100644
--- a/dune-project
+++ b/dune-project
@@ -1,12 +1,12 @@
(lang dune 3.13)
(cram enable)
-(name serde)
+(name serde_json)
(generate_opam_files true)
(source
- (github serde-ml/serde))
+ (github serde-ml/json))
(authors "Leandro Ostera <leandro@abstractmachines.dev>")
@@ -14,30 +14,6 @@
(license "MIT")
-(package
- (name serde)
- (synopsis "A serialization framework for OCaml")
- (description "Serde is a serialization framework for OCaml that runs on the principle of maximum efficiency and user ergonomics while maintaining format flexibility.")
- (depends
- (ocaml (>= "5.1.1"))
- (qcheck :with-test)
- (rio (>= "0.0.8"))
- (spices :with-test)
- dune))
-
-
-(package
- (name serde_derive)
- (synopsis "Derive-macros for the Serde serialization framework")
- (description "These macros help derive serializers and deserializers for your existing types and provide all the functionality you expect to plug in different data-formats.")
- (depends
- (ocaml (>= "5.1.1"))
- (ppx_deriving (>= "5.2.1"))
- (ppxlib (>= "0.28.0"))
- (serde (= :version))
- dune))
-
-
(package
(name serde_json)
(synopsis "JSON format support for Serde")
diff --git a/examples/dune b/examples/dune
deleted file mode 100644
index f53c4a5..0000000
--- a/examples/dune
+++ /dev/null
@@ -1,5 +0,0 @@
-(executable
- (name starfleet)
- (preprocess
- (pps serde_derive))
- (libraries serde serde_json))
diff --git a/examples/starfleet.ml b/examples/starfleet.ml
deleted file mode 100644
index 37a4060..0000000
--- a/examples/starfleet.ml
+++ /dev/null
@@ -1,32 +0,0 @@
-(* type rank = Captain | Chief_petty_officer *)
-(* type t = { name : string; rank : rank } *)
-
-(* let obrien = { name = "Miles O'Brien"; rank = Chief_petty_officer } *)
-(* let sisko = { name = "Benjamin Sisko"; rank = Captain } *)
-
-type rank = { rank_name : string; rank_scores : string list }
-[@@deriving serialize]
-
-type t = {
- name : string;
- commisioned : bool;
- updated_at : int64;
- credits : int32 option;
- keywords : string array;
- rank : rank;
-}
-[@@deriving serialize]
-
-let () =
- let test_t =
- {
- name = "hello";
- commisioned = false;
- updated_at = Int64.(sub max_int 1L);
- credits = None;
- keywords = [||];
- rank = { rank_name = "asdf"; rank_scores = [ "1"; "c"; "a" ] };
- }
- in
- let json = Serde_json.to_string serialize_t test_t |> Result.get_ok in
- Format.printf "%s\n%!" json
diff --git a/serde.opam b/serde.opam
deleted file mode 100644
index bfd9314..0000000
--- a/serde.opam
+++ /dev/null
@@ -1,33 +0,0 @@
-# This file is generated by dune, edit dune-project instead
-opam-version: "2.0"
-synopsis: "A serialization framework for OCaml"
-description:
- "Serde is a serialization framework for OCaml that runs on the principle of maximum efficiency and user ergonomics while maintaining format flexibility."
-maintainer: ["Leandro Ostera <leandro@abstractmachines.dev>"]
-authors: ["Leandro Ostera <leandro@abstractmachines.dev>"]
-license: "MIT"
-homepage: "https://github.com/serde-ml/serde"
-bug-reports: "https://github.com/serde-ml/serde/issues"
-depends: [
- "ocaml" {>= "5.1.1"}
- "qcheck" {with-test}
- "rio" {>= "0.0.8"}
- "spices" {with-test}
- "dune" {>= "3.13"}
- "odoc" {with-doc}
-]
-build: [
- ["dune" "subst"] {dev}
- [
- "dune"
- "build"
- "-p"
- name
- "-j"
- jobs
- "@install"
- "@runtest" {with-test}
- "@doc" {with-doc}
- ]
-]
-dev-repo: "git+https://github.com/serde-ml/serde.git"
diff --git a/serde/dune b/serde/dune
deleted file mode 100644
index 4074b7e..0000000
--- a/serde/dune
+++ /dev/null
@@ -1,10 +0,0 @@
-(library
- (public_name serde)
- (modules serde)
- (libraries rio))
-
-(test
- (package serde)
- (name serde_test)
- (modules serde_test)
- (libraries serde qcheck spices))
diff --git a/serde/serde.ml b/serde/serde.ml
deleted file mode 100644
index d869278..0000000
--- a/serde/serde.ml
+++ /dev/null
@@ -1,764 +0,0 @@
-let ( let* ) = Result.bind
-
-let pp_list pp_el fmt t =
- Format.fprintf fmt "[";
- Format.pp_print_list
- ~pp_sep:(fun fmt () -> Format.fprintf fmt "; ")
- pp_el fmt t;
- Format.fprintf fmt "]"
-
-type error =
- [ `invalid_field_type
- | `missing_field
- | `no_more_data
- | `unimplemented
- | `invalid_tag
- | `Msg of string
- | Rio.io_error ]
-
-let pp_err fmt t =
- match t with
- | `invalid_field_type -> Format.fprintf fmt "invalid_field_type"
- | `missing_field -> Format.fprintf fmt "missing_field"
- | `no_more_data -> Format.fprintf fmt "no_more_data"
- | `unimplemented -> Format.fprintf fmt "unimplemented"
- | `invalid_tag -> Format.fprintf fmt "invalid_tag"
- | `Msg str -> Format.fprintf fmt "%S" str
- | #Rio.io_error as err -> Rio.pp_err fmt err
-
-module Config = struct
- type t = { camelcase_fields : bool }
-
- let default = { camelcase_fields = false }
-end
-
-module rec Ser_base : sig
- type ('value, 'state, 'output) t =
- 'value -> ('value, 'state, 'output) ctx -> ('output, error) result
-
- and ('value, 'state, 'output) ctx =
- | Ctx of
- ('value, 'state, 'output) t
- * ('state, 'output) Ser_base.serializer
- * 'state
-
- val serializer : ('value, 'state, 'output) t -> ('value, 'state, 'output) t
-
- module type Serializer = sig
- type output
- type state
-
- val nest : state -> state
-
- val serialize_bool :
- ('value, state, output) ctx -> state -> bool -> (output, error) result
-
- val serialize_int8 :
- ('value, state, output) ctx -> state -> char -> (output, error) result
-
- val serialize_int16 :
- ('value, state, output) ctx -> state -> int -> (output, error) result
-
- val serialize_int31 :
- ('value, state, output) ctx -> state -> int -> (output, error) result
-
- val serialize_int32 :
- ('value, state, output) ctx -> state -> int32 -> (output, error) result
-
- val serialize_int64 :
- ('value, state, output) ctx -> state -> int64 -> (output, error) result
-
- val serialize_float :
- ('value, state, output) ctx -> state -> float -> (output, error) result
-
- val serialize_string :
- ('value, state, output) ctx -> state -> string -> (output, error) result
-
- val serialize_none :
- ('value, state, output) ctx -> state -> (output, error) result
-
- val serialize_some :
- ('value, state, output) ctx ->
- state ->
- (('value, state, output) ctx -> (output, error) result) ->
- (output, error) result
-
- val serialize_sequence :
- ('value, state, output) ctx ->
- state ->
- size:int ->
- (('value, state, output) ctx -> (output, error) result) ->
- (output, error) result
-
- val serialize_element :
- ('value, state, output) ctx ->
- state ->
- (('value, state, output) ctx -> (output, error) result) ->
- (output, error) result
-
- val serialize_unit_variant :
- ('value, state, output) ctx ->
- state ->
- var_type:string ->
- cstr_idx:int ->
- cstr_name:string ->
- (output, error) result
-
- val serialize_newtype_variant :
- ('value, state, output) ctx ->
- state ->
- var_type:string ->
- cstr_idx:int ->
- cstr_name:string ->
- (('value, state, output) ctx -> (output, error) result) ->
- (output, error) result
-
- val serialize_tuple_variant :
- ('value, state, output) ctx ->
- state ->
- var_type:string ->
- cstr_idx:int ->
- cstr_name:string ->
- size:int ->
- (('value, state, output) ctx -> (output, error) result) ->
- (output, error) result
-
- val serialize_record_variant :
- ('value, state, output) ctx ->
- state ->
- var_type:string ->
- cstr_idx:int ->
- cstr_name:string ->
- size:int ->
- (('value, state, output) ctx -> (output, error) result) ->
- (output, error) result
-
- val serialize_record :
- ('value, state, output) ctx ->
- state ->
- rec_type:string ->
- size:int ->
- (('value, state, output) ctx -> (output, error) result) ->
- (output, error) result
-
- val serialize_field :
- ('value, state, output) ctx ->
- state ->
- name:string ->
- (('value, state, output) ctx -> (output, error) result) ->
- (output, error) result
- end
-
- type ('state, 'output) serializer =
- (module Serializer with type output = 'output and type state = 'state)
-end = struct
- type ('value, 'state, 'output) t =
- 'value -> ('value, 'state, 'output) ctx -> ('output, error) result
-
- and ('value, 'state, 'output) ctx =
- | Ctx of
- ('value, 'state, 'output) t
- * ('state, 'output) Ser_base.serializer
- * 'state
-
- let serializer fn = fn
-
- module type Serializer = sig
- type output
- type state
-
- val nest : state -> state
-
- val serialize_bool :
- ('value, state, output) ctx -> state -> bool -> (output, error) result
-
- val serialize_int8 :
- ('value, state, output) ctx -> state -> char -> (output, error) result
-
- val serialize_int16 :
- ('value, state, output) ctx -> state -> int -> (output, error) result
-
- val serialize_int31 :
- ('value, state, output) ctx -> state -> int -> (output, error) result
-
- val serialize_int32 :
- ('value, state, output) ctx -> state -> int32 -> (output, error) result
-
- val serialize_int64 :
- ('value, state, output) ctx -> state -> int64 -> (output, error) result
-
- val serialize_float :
- ('value, state, output) ctx -> state -> float -> (output, error) result
-
- val serialize_string :
- ('value, state, output) ctx -> state -> string -> (output, error) result
-
- val serialize_none :
- ('value, state, output) ctx -> state -> (output, error) result
-
- val serialize_some :
- ('value, state, output) ctx ->
- state ->
- (('value, state, output) ctx -> (output, error) result) ->
- (output, error) result
-
- val serialize_sequence :
- ('value, state, output) ctx ->
- state ->
- size:int ->
- (('value, state, output) ctx -> (output, error) result) ->
- (output, error) result
-
- val serialize_element :
- ('value, state, output) ctx ->
- state ->
- (('value, state, output) ctx -> (output, error) result) ->
- (output, error) result
-
- val serialize_unit_variant :
- ('value, state, output) ctx ->
- state ->
- var_type:string ->
- cstr_idx:int ->
- cstr_name:string ->
- (output, error) result
-
- val serialize_newtype_variant :
- ('value, state, output) ctx ->
- state ->
- var_type:string ->
- cstr_idx:int ->
- cstr_name:string ->
- (('value, state, output) ctx -> (output, error) result) ->
- (output, error) result
-
- val serialize_tuple_variant :
- ('value, state, output) ctx ->
- state ->
- var_type:string ->
- cstr_idx:int ->
- cstr_name:string ->
- size:int ->
- (('value, state, output) ctx -> (output, error) result) ->
- (output, error) result
-
- val serialize_record_variant :
- ('value, state, output) ctx ->
- state ->
- var_type:string ->
- cstr_idx:int ->
- cstr_name:string ->
- size:int ->
- (('value, state, output) ctx -> (output, error) result) ->
- (output, error) result
-
- val serialize_record :
- ('value, state, output) ctx ->
- state ->
- rec_type:string ->
- size:int ->
- (('value, state, output) ctx -> (output, error) result) ->
- (output, error) result
-
- val serialize_field :
- ('value, state, output) ctx ->
- state ->
- name:string ->
- (('value, state, output) ctx -> (output, error) result) ->
- (output, error) result
- end
-
- type ('state, 'output) serializer =
- (module Serializer with type output = 'output and type state = 'state)
-end
-
-module Ser = struct
- include Ser_base
-
- let serialize (type value state output) (ctx : (value, state, output) ctx)
- (ser : (value, state, output) ctx -> (output, error) result) :
- (output, error) result =
- ser ctx
-
- let serialize_sequence (type value state output)
- (Ctx (_, (module S), state) as self : (value, state, output) ctx) size
- elements =
- S.serialize_sequence self state ~size elements
-
- let serialize_record (type value state output)
- (Ctx (_, (module S), state) as self : (value, state, output) ctx) rec_type
- size fields =
- S.serialize_record self state ~rec_type ~size fields
-
- let sequence (type value state output)
- (Ctx (_, (module S), state) as self : (value, state, output) ctx) size
- elements =
- S.serialize_sequence self state ~size elements
-
- let unit_variant (type value state output)
- (Ctx (_, (module S), state) as self : (value, state, output) ctx) var_type
- cstr_idx cstr_name =
- S.serialize_unit_variant self state ~var_type ~cstr_idx ~cstr_name
-
- let newtype_variant (type value state output)
- (Ctx (_, (module S), state) as self : (value, state, output) ctx) var_type
- cstr_idx cstr_name value =
- S.serialize_newtype_variant self state ~var_type ~cstr_idx ~cstr_name value
-
- let tuple_variant (type value state output)
- (Ctx (_, (module S), state) as ctx : (value, state, output) ctx) var_type
- cstr_idx cstr_name size =
- S.serialize_tuple_variant ctx state ~var_type ~cstr_idx ~cstr_name ~size
-
- let record_variant (type value state output)
- (Ctx (_, (module S), state) as ctx : (value, state, output) ctx) var_type
- cstr_idx cstr_name size =
- S.serialize_record_variant ctx state ~var_type ~cstr_idx ~cstr_name ~size
-
- let record (type value state output)
- (Ctx (_, (module S), state) as ctx : (value, state, output) ctx) rec_type
- size =
- S.serialize_record ctx state ~rec_type ~size
-
- let element (type value state output)
- (Ctx (_, (module S), state) as ctx : (value, state, output) ctx) value =
- S.serialize_element ctx state value
-
- let field (type value state output)
- (Ctx (_, (module S), state) as ctx : (value, state, output) ctx) name
- value =
- S.serialize_field ctx state ~name value
-
- let bool (type value state output) bool
- (Ctx (_, (module S), state) as self : (value, state, output) ctx) =
- S.serialize_bool self state bool
-
- let serialize_int8 (type value state output) int
- (Ctx (_, (module S), state) as self : (value, state, output) ctx) =
- S.serialize_int8 self state int
-
- let serialize_int16 (type value state output) int
- (Ctx (_, (module S), state) as self : (value, state, output) ctx) =
- S.serialize_int16 self state int
-
- let serialize_int31 (type value state output) int
- (Ctx (_, (module S), state) as self : (value, state, output) ctx) =
- S.serialize_int31 self state int
-
- let serialize_int32 (type value state output) int
- (Ctx (_, (module S), state) as self : (value, state, output) ctx) =
- S.serialize_int32 self state int
-
- let serialize_int64 (type value state output) int
- (Ctx (_, (module S), state) as self : (value, state, output) ctx) =
- S.serialize_int64 self state int
-
- let serialize_float (type value state output) float
- (Ctx (_, (module S), state) as self : (value, state, output) ctx) =
- S.serialize_float self state float
-
- let int int ctx = serialize_int31 int ctx
- let int8 int ctx = serialize_int8 int ctx
- let int16 int ctx = serialize_int16 int ctx
- let int32 int ctx = serialize_int32 int ctx
- let int64 int ctx = serialize_int64 int ctx
- let float float ctx = serialize_float float ctx
-
- let string (type value state output) string
- (Ctx (_, (module S), state) as self : (value, state, output) ctx) =
- S.serialize_string self state string
-
- let option (type value state output) ser value
- (Ctx (_, (module S), state) as self : (value, state, output) ctx) =
- match value with
- | None -> S.serialize_none self state
- | Some s -> S.serialize_some self state (fun ctx -> ser s ctx)
-
- let list ser values ctx =
- sequence ctx (List.length values) @@ fun ctx ->
- List.fold_left
- (fun acc el -> match acc with Ok () -> element ctx (ser el) | _ -> acc)
- (Ok ()) values
-
- let array ser values ctx = list ser (Array.to_list values) ctx
-
- let s :
- type value value2 state output.
- (value, state, output) t ->
- value ->
- (value2, state, output) ctx ->
- (output, error) result =
- fun ser value (Ctx (_self, (module S), state)) ->
- let state = S.nest state in
- ser value (Ctx (ser, (module S), state))
-end
-
-module rec De_base : sig
- type ('value, 'state) t = 'state De_base.ctx -> ('value, error) result
- and 'state ctx = 'state De_base.deserializer * 'state
-
- type ('value, 'state, 'tag) visitor = {
- visit_int : 'state De_base.ctx -> int -> ('value, error) result;
- visit_string : 'state De_base.ctx -> string -> ('value, error) result;
- visit_variant : 'state De_base.ctx -> ('value, error) result;
- }
-
- val deserializer :
- ('state De_base.ctx -> ('value, error) result) -> ('value, 'state) t
-
- module type Deserializer = sig
- type state
-
- val nest : state -> state
-
- val deserialize_sequence :
- state ctx ->
- state ->
- size:int ->
- (size:int -> ('value, state) t) ->
- ('value, error) result
-
- val deserialize_element :
- state ctx -> state -> ('value, state) t -> ('value option, error) result
-
- val deserialize_variant :
- state ctx ->
- state ->
- ('value, state, 'tag) visitor ->
- name:string ->
- variants:string list ->
- ('value, error) result
-
- val deserialize_unit_variant : state ctx -> state -> (unit, error) result
-
- val deserialize_newtype_variant :
- state ctx -> state -> ('value, state) t -> ('value, error) result
-
- val deserialize_tuple_variant :
- state ctx ->
- state ->
- size:int ->
- (size:int -> ('value, state) t) ->
- ('value, error) result
-
- val deserialize_record_variant :
- state ctx ->
- state ->
- size:int ->
- (size:int -> ('value, state) t) ->
- ('value, error) result
-
- val deserialize_record :
- state ctx ->
- state ->
- name:string ->
- size:int ->
- ('value, state) t ->
- ('value, error) result
-
- val deserialize_field :
- state ctx ->
- state ->
- name:string ->
- ('value, state) t ->
- ('value, error) result
-
- val deserialize_key :
- state ctx ->
- state ->
- ('value, state, 'tag) visitor ->
- ('value option, error) result
-
- val deserialize_identifier :
- state ctx ->
- state ->
- ('value, state, 'tag) visitor ->
- ('value, error) result
-
- val deserialize_string : state ctx -> state -> (string, error) result
- val deserialize_int8 : state ctx -> state -> (char, error) result
- val deserialize_int16 : state ctx -> state -> (int, error) result
- val deserialize_int31 : state ctx -> state -> (int, error) result
- val deserialize_int32 : state ctx -> state -> (int32, error) result
- val deserialize_int64 : state ctx -> state -> (int64, error) result
- val deserialize_bool : state ctx -> state -> (bool, error) result
- val deserialize_float : state ctx -> state -> (float, error) result
-
- val deserialize_option :
- state ctx -> state -> ('value, state) t -> ('value option, error) result
- end
-
- type 'state deserializer = (module Deserializer with type state = 'state)
-end = struct
- type ('value, 'state) t = 'state De_base.ctx -> ('value, error) result
- and 'state ctx = 'state De_base.deserializer * 'state
-
- type ('value, 'state, 'tag) visitor = {
- visit_int : 'state De_base.ctx -> int -> ('value, error) result;
- visit_string : 'state De_base.ctx -> string -> ('value, error) result;
- visit_variant : 'state De_base.ctx -> ('value, error) result;
- }
-
- let deserializer fn = fn
-
- module type Deserializer = sig
- type state
-
- val nest : state -> state
-
- val deserialize_sequence :
- state ctx ->
- state ->
- size:int ->
- (size:int -> ('value, state) t) ->
- ('value, error) result
-
- val deserialize_element :
- state ctx -> state -> ('value, state) t -> ('value option, error) result
-
- val deserialize_variant :
- state ctx ->
- state ->
- ('value, state, 'tag) visitor ->
- name:string ->
- variants:string list ->
- ('value, error) result
-
- val deserialize_unit_variant : state ctx -> state -> (unit, error) result
-
- val deserialize_newtype_variant :
- state ctx -> state -> ('value, state) t -> ('value, error) result
-
- val deserialize_tuple_variant :
- state ctx ->
- state ->
- size:int ->
- (size:int -> ('value, state) t) ->
- ('value, error) result
-
- val deserialize_record_variant :
- state ctx ->
- state ->
- size:int ->
- (size:int -> ('value, state) t) ->
- ('value, error) result
-
- val deserialize_record :
- state ctx ->
- state ->
- name:string ->
- size:int ->
- ('value, state) t ->
- ('value, error) result
-
- val deserialize_field :
- state ctx ->
- state ->
- name:string ->
- ('value, state) t ->
- ('value, error) result
-
- val deserialize_key :
- state ctx ->
- state ->
- ('value, state, 'tag) visitor ->
- ('value option, error) result
-
- val deserialize_identifier :
- state ctx ->
- state ->
- ('value, state, 'tag) visitor ->
- ('value, error) result
-
- val deserialize_string : state ctx -> state -> (string, error) result
- val deserialize_int8 : state ctx -> state -> (char, error) result
- val deserialize_int16 : state ctx -> state -> (int, error) result
- val deserialize_int31 : state ctx -> state -> (int, error) result
- val deserialize_int32 : state ctx -> state -> (int32, error) result
- val deserialize_int64 : state ctx -> state -> (int64, error) result
- val deserialize_bool : state ctx -> state -> (bool, error) result
- val deserialize_float : state ctx -> state -> (float, error) result
-
- val deserialize_option :
- state ctx -> state -> ('value, state) t -> ('value option, error) result
- end
-
- type 'state deserializer = (module Deserializer with type state = 'state)
-end
-
-module Visitor = struct
- type ('value, 'state, 'tag) t = ('value, 'state, 'tag) De_base.visitor = {
- visit_int : 'state De_base.ctx -> int -> ('value, error) result;
- visit_string : 'state De_base.ctx -> string -> ('value, error) result;
- visit_variant : 'state De_base.ctx -> ('value, error) result;
- }
-
- let default =
- De_base.
- {
- visit_int = (fun _ctx _int -> Error `unimplemented);
- visit_string = (fun _ctx _str -> Error `unimplemented);
- visit_variant = (fun _ctx -> Error `unimplemented);
- }
-
- let make ?(visit_int = default.visit_int)
- ?(visit_string = default.visit_string) () =
- { default with visit_int; visit_string }
-
- let visit_variant ctx t = t.visit_variant ctx
- let visit_string ctx t str = t.visit_string ctx str
- let visit_int ctx t str = t.visit_int ctx str
-end
-
-module De = struct
- include De_base
-
- let deserialize ctx de = de ctx
-
- let deserialize_int8 (type state) (((module D), state) as ctx : state ctx) =
- D.deserialize_int8 ctx state
-
- let deserialize_int16 (type state) (((module D), state) as ctx : state ctx) =
- D.deserialize_int16 ctx state
-
- let deserialize_int31 (type state) (((module D), state) as ctx : state ctx) =
- D.deserialize_int31 ctx state
-
- let deserialize_int32 (type state) (((module D), state) as ctx : state ctx) =
- D.deserialize_int32 ctx state
-
- let deserialize_int64 (type state) (((module D), state) as ctx : state ctx) =
- D.deserialize_int64 ctx state
-
- let deserialize_bool (type state) (((module D), state) as ctx : state ctx) =
- D.deserialize_bool ctx state
-
- let deserialize_float (type state) (((module D), state) as ctx : state ctx) =
- D.deserialize_float ctx state
-
- let deserialize_record (type state) (((module D), state) as ctx : state ctx)
- name size de =
- D.deserialize_record ctx state ~name ~size de
-
- let deserialize_field (type state) (((module D), state) as ctx : state ctx)
- name de =
- D.deserialize_field ctx state ~name de
-
- let deserialize_sequence (type state) (((module D), state) as ctx : state ctx)
- size de =
- D.deserialize_sequence ctx state ~size de
-
- let deserialize_element (type state) (((module D), state) as ctx : state ctx)
- de =
- D.deserialize_element ctx state de
-
- let deserialize_variant (type state) (((module D), state) as ctx : state ctx)
- ~visitor ~name ~variants =
- D.deserialize_variant ctx state visitor ~name ~variants
-
- let deserialize_unit_variant (type state)
- (((module D), state) as ctx : state ctx) =
- D.deserialize_unit_variant ctx state
-
- let deserialize_newtype_variant (type state)
- (((module D), state) as ctx : state ctx) de =
- D.deserialize_newtype_variant ctx state de
-
- let deserialize_tuple_variant (type state)
- (((module D), state) as ctx : state ctx) size de =
- D.deserialize_tuple_variant ctx state ~size de
-
- let deserialize_record_variant (type state)
- (((module D), state) as ctx : state ctx) size de =
- D.deserialize_record_variant ctx state ~size de
-
- let deserialize_key (type state) (((module D), state) as ctx : state ctx)
- visitor =
- D.deserialize_key ctx state visitor
-
- let deserialize_identifier (type state)
- (((module D), state) as ctx : state ctx) visitor =
- D.deserialize_identifier ctx state visitor
-
- let deserialize_string (type state) (((module D), state) as ctx : state ctx) =
- D.deserialize_string ctx state
-
- let deserialize_option (type state) (((module D), state) as ctx : state ctx)
- de =
- D.deserialize_option ctx state de
-
- let record ctx name size de = deserialize_record ctx name size de
-
- let variant ctx name variants visit_variant =
- let visitor = { Visitor.default with visit_variant } in
- deserialize_variant ctx ~visitor ~name ~variants
-
- let sequence ctx de = deserialize_sequence ctx 0 de
- let bool ctx = deserialize_bool ctx
- let int ctx = deserialize_int31 ctx
- let int8 ctx = deserialize_int8 ctx
- let int16 ctx = deserialize_int16 ctx
- let int32 ctx = deserialize_int32 ctx
- let int64 ctx = deserialize_int64 ctx
- let string ctx = deserialize_string ctx
- let identifier ctx visitor = deserialize_identifier ctx visitor
- let unit_variant ctx = deserialize_unit_variant ctx
- let newtype_variant ctx de = deserialize_newtype_variant ctx de
- let tuple_variant ctx size de = deserialize_tuple_variant ctx size de
- let record_variant ctx size de = deserialize_record_variant ctx size de
- let element ctx de = deserialize_element ctx de
- let field ctx name de = deserialize_field ctx name de
- let next_field ctx visitor = deserialize_key ctx visitor
- let option de ctx = deserialize_option ctx de
- let float ctx = deserialize_float ctx
-
- let list de ctx =
- sequence ctx @@ fun ~size:_ ctx ->
- let rec read_elements acc =
- let* v = element ctx de in
- match v with Some s -> read_elements (s :: acc) | None -> Ok acc
- in
- let* list = read_elements [] in
- Ok (List.rev list)
-
- let array de ctx =
- let* list = list de ctx in
- Ok (Array.of_list list)
-
- let d (type state) de ((((module D) as self), state) : state ctx) =
- let state = D.nest state in
- de (self, state)
-end
-
-module Serializer = struct
- type ('state, 'output) t = ('state, 'output) Ser.serializer
-
- module type Intf = Ser.Serializer
-
- module Default = struct end
-end
-
-module Deserializer = struct
- type 'state t = 'state De.deserializer
-
- module type Intf = De.Deserializer
-
- module Default = struct end
-end
-
-let serialize :
- type value state output.
- (state, output) Serializer.t ->
- state ->
- (value, state, output) Ser.t ->
- value ->
- (output, error) result =
- fun fmt ctx ser value -> ser value (Ctx (ser, fmt, ctx))
-
-let deserialize :
- type value state output.
- state Deserializer.t ->
- state ->
- (value, state) De.t ->
- (value, error) result =
- fun fmt ctx de -> de (fmt, ctx)
diff --git a/serde/serde_test.ml b/serde/serde_test.ml
deleted file mode 100644
index 582f864..0000000
--- a/serde/serde_test.ml
+++ /dev/null
@@ -1,611 +0,0 @@
-open Serde
-
-module Serde_bin = struct
- module Serializer = struct
- type output = unit
- type state = S : { fmt : 'w Rio.Writer.t } -> state
-
- let nest (S { fmt }) = S { fmt }
-
- let serialize_none _self (S { fmt; _ }) =
- let bytes = Bytes.create 1 in
- Bytes.set_int8 bytes 0 0;
- Rio.write_all fmt ~buf:(Bytes.to_string bytes)
-
- let serialize_some self (S { fmt; _ }) de =
- let bytes = Bytes.create 1 in
- Bytes.set_int8 bytes 0 1;
- let* () = Rio.write_all fmt ~buf:(Bytes.to_string bytes) in
- Ser.serialize self de
-
- let serialize_string self (S { fmt; _ }) str =
- let* () = Ser.serialize_int31 (String.length str) self in
- Rio.write_all fmt ~buf:str
-
- let serialize_bool self (S _) bool =
- let int = if bool then Char.chr 0 else Char.chr 1 in
- Ser.serialize_int8 int self
-
- let serialize_int8 _self (S { fmt; _ }) int =
- let bytes = Bytes.create 1 in
- Bytes.set bytes 0 int;
- Rio.write_all fmt ~buf:(Bytes.to_string bytes)
-
- let serialize_int16 _self (S { fmt; _ }) int =
- let bytes = Bytes.create 2 in
- Bytes.set_int16_be bytes 0 int;
- Rio.write_all fmt ~buf:(Bytes.to_string bytes)
-
- let serialize_int31 _self (S { fmt; _ }) int =
- let bytes = Bytes.create 4 in
- Bytes.set_int32_be bytes 0 (Int32.of_int int);
- Rio.write_all fmt ~buf:(Bytes.to_string bytes)
-
- let serialize_int32 _self (S { fmt; _ }) int =
- let bytes = Bytes.create 4 in
- Bytes.set_int32_be bytes 0 int;
- Rio.write_all fmt ~buf:(Bytes.to_string bytes)
-
- let serialize_int64 _self (S { fmt; _ }) int =
- let bytes = Bytes.create 8 in
- Bytes.set_int64_be bytes 0 int;
- Rio.write_all fmt ~buf:(Bytes.to_string bytes)
-
- let serialize_float _self (S { fmt; _ }) float =
- let bytes = Bytes.create 8 in
- let bof = Int64.bits_of_float float in
- Bytes.set_int64_be bytes 0 bof;
- Rio.write_all fmt ~buf:(Bytes.to_string bytes)
-
- let serialize_sequence self (S _) ~size elements =
- let* () = Ser.serialize_int31 size self in
- Ser.serialize self elements
-
- let serialize_element self (S _) element = Ser.serialize self element
-
- let serialize_unit_variant self (S _) ~var_type:_ ~cstr_idx ~cstr_name:_ =
- Ser.serialize_int31 cstr_idx self
-
- let serialize_tuple_variant self (S _) ~var_type:_ ~cstr_idx ~cstr_name:_
- ~size args =
- let* () = Ser.serialize_int31 cstr_idx self in
- let* () = Ser.serialize_int31 size self in
- Ser.serialize self args
-
- let serialize_newtype_variant self (S _) ~var_type:_ ~cstr_idx ~cstr_name:_
- args =
- let* () = Ser.serialize_int31 cstr_idx self in
- Ser.serialize self args
-
- let serialize_record_variant self (S _) ~var_type:_ ~cstr_idx ~cstr_name:_
- ~size args =
- let* () = Ser.serialize_int31 cstr_idx self in
- let* () = Ser.serialize_int31 size self in
- Ser.serialize self args
-
- let serialize_record self (S _) ~rec_type:_ ~size:_ fields =
- Ser.serialize self fields
-
- let serialize_field self (S _) ~name:_ element = Ser.serialize self element
- end
-
- module Deserializer = struct
- type state =
- | D : {
- reader : 'a Rio.Reader.t;
- mutable size : int;
- mutable off : int;
- }
- -> state
-
- let nest (D { reader; _ }) = D { reader; size = 0; off = 0 }
-
- let read capacity (D { reader; _ }) =
- let bytes = Bytes.create capacity in
- let* len = Rio.read reader bytes in
- Ok (Bytes.sub bytes 0 len)
-
- let read_int capacity state fn =
- let* bytes = read capacity state in
- Ok (fn bytes 0)
-
- let deserialize_int8 _self state = read_int 1 state Bytes.get
- let deserialize_int16 _self state = read_int 2 state Bytes.get_int16_be
-
- let deserialize_int31 _self state =
- let* int = read_int 4 state Bytes.get_int32_be in
- Ok (Int32.to_int int)
-
- let deserialize_int32 _self state = read_int 4 state Bytes.get_int32_be
- let deserialize_int64 _self state = read_int 8 state Bytes.get_int64_be
-
- let deserialize_float _self state =
- let* float = read_int 8 state Bytes.get_int64_be in
- Ok (Int64.float_of_bits float)
-
- (* let deserialize_none self _state = *)
- (* let* int = De.deserialize_int8 self in *)
- (* if Char.equal int (Char.chr 0) then Ok () *)
- (* else Error (`Msg "expected 0 to deserialize none") *)
-
- (* let deserialize_some self _state de = De.deserialize self de *)
-
- let deserialize_string self state =
- let* len = De.deserialize_int31 self in
- let* bytes = read len state in
- Ok (Bytes.unsafe_to_string bytes)
-
- let deserialize_bool self _state =
- let* bool = De.deserialize_int8 self in
- if Char.equal bool (Char.chr 0) then Ok true else Ok false
-
- let deserialize_sequence self (D s) ~size:_ elements =
- let* size = De.deserialize_int31 self in
- s.size <- size;
- De.deserialize self (elements ~size)
-
- let deserialize_element self (D s) element =
- if s.off < s.size then (
- let* v = De.deserialize self element in
- s.off <- s.off + 1;
- Ok (Some v))
- else Ok None
-
- let deserialize_unit_variant _self _state = Ok ()
- let deserialize_newtype_variant self _state args = De.deserialize self args
-
- let deserialize_tuple_variant self (D s) ~size:_ args =
- let* size = De.deserialize_int31 self in
- s.size <- size;
- De.deserialize self (args ~size)
-
- let deserialize_record_variant self (D s) ~size:_ args =
- let* size = De.deserialize_int31 self in
- s.size <- size;
- De.deserialize self (args ~size)
-
- let deserialize_record self _state ~name:_ ~size:_ fields =
- De.deserialize self fields
-
- let deserialize_field self _state ~name:_ element =
- De.deserialize self element
-
- let deserialize_key _self _state _visitor = Ok None
-
- let deserialize_identifier self _state visitor =
- let* str = De.deserialize_int31 self in
- Visitor.visit_int self visitor str
-
- let deserialize_option self _state de =
- let* tag = De.deserialize_int8 self in
- if Char.equal tag (Char.chr 0) then Ok None
- else
- let* v = De.deserialize self de in
- Ok (Some v)
-
- let deserialize_variant self _state visitor ~name:_ ~variants:_ =
- Visitor.visit_variant self visitor
- end
-
- let to_string ser value =
- let buf = Buffer.create 0 in
- let state = Serializer.S { fmt = Rio.Buffer.to_writer buf } in
- let* () = Serde.serialize (module Serializer) state ser value in
- Ok (Buffer.to_bytes buf |> Bytes.unsafe_to_string)
-
- let of_string de string =
- let module StrRead = struct
- type t = { src : string; mutable pos : int }
-
- let make src = { src; pos = 0 }
-
- let read t ?timeout:_ dst =
- let src = t.src in
- let len = Int.min (String.length src - t.pos) (Bytes.length dst) in
- BytesLabels.blit_string ~src ~src_pos:t.pos ~dst ~dst_pos:0 ~len;
- t.pos <- t.pos + len;
- Ok len
-
- let read_vectored _src _iov = Ok 0
- end in
- let reader =
- Rio.Reader.of_read_src (module StrRead) StrRead.(make string)
- in
- let state = Deserializer.(D { reader; size = 0; off = 0 }) in
- Serde.deserialize (module Deserializer) state de
-end
-
-let keyword fmt = Spices.(default |> fg (color "#00FF00") |> build) fmt
-let error fmt = Spices.(default |> fg (color "#FF0000") |> build) fmt
-
-type simple_variant = A
-type variant_with_arg = B of int
-type variant_with_many_args = C of int * string * float
-type simple_record = { name : string; year : int [@warning "-69"] }
-type variant_with_inline_record = D of { is_inline : bool }
-type nested = { nested_flag : bool }
-type record_nested = { nested : nested }
-type record_with_list = { keys : string list; collection : string }
-type with_option = string option
-type with_nested_option = { nested_opt : with_option }
-type with_list = string list
-type with_array = string array
-
-let pp_variant fmt A = Format.fprintf fmt "A"
-let pp_variant_with_arg fmt (B i) = Format.fprintf fmt "(B %d)" i
-
-let pp_variant_with_many_arg fmt (C (i, str, float)) =
- Format.fprintf fmt "(C (%d, %S, %F))" i str float
-
-let pp_record fmt { name; year } =
- Format.fprintf fmt "{name=%S;year=%d}" name year
-
-let pp_variant_with_inline_record fmt (D { is_inline }) =
- Format.fprintf fmt "(D {is_inline=%b})" is_inline
-
-let pp_record_nested fmt { nested = { nested_flag } } =
- Format.fprintf fmt "({nested={nested_flag=%b}})" nested_flag
-
-let pp_with_option fmt opt =
- match opt with
- | None -> Format.fprintf fmt "None"
- | Some s -> Format.fprintf fmt "(Some %S)" s
-
-let pp_with_nested_option fmt { nested_opt } =
- Format.fprintf fmt "({nested_opt=%a})" pp_with_option nested_opt
-
-let pp_with_list fmt (t : with_list) =
- Format.fprintf fmt "[";
- Format.pp_print_list
- ~pp_sep:(fun fmt () -> Format.fprintf fmt "; ")
- (fun fmt s -> Format.fprintf fmt "%S" s)
- fmt t;
- Format.fprintf fmt "]"
-
-let pp_with_array fmt (t : with_array) =
- Format.fprintf fmt "[|";
- Format.pp_print_array
- ~pp_sep:(fun fmt () -> Format.fprintf fmt "; ")
- (fun fmt s -> Format.fprintf fmt "%S" s)
- fmt t;
- Format.fprintf fmt "|]"
-
-let pp_record_with_list fmt { keys; collection } =
- Format.fprintf fmt "{keys=%a;collection=%S}" pp_with_list keys collection
-
-let _serde_bin_roundtrip_tests =
- let test str pp ser de value expect_str =
- let actual_str =
- match
- let* bin = Serde_bin.to_string ser value in
- (* Format.printf "bin: %S for %a\n%!" bin pp value; *)
- Serde_bin.of_string de bin
- with
- | Ok actual -> Format.asprintf "%a" pp actual
- | Error err -> Format.asprintf "Exception: %a" Serde.pp_err err
- in
-
- if String.equal actual_str expect_str then
- Format.printf "serde_bin.ser/de test %S %s\r\n%!" str (keyword "OK")
- else (
- Format.printf "%s\n\nExpected:\n\n%s\n\nbut found:\n\n%s\n\n"
- (error "bin does not match")
- expect_str actual_str;
- assert false)
- in
-
- test "variant_without_args" pp_variant
- Ser.(serializer @@ fun A ctx -> unit_variant ctx "simple_variant" 0 "A")
- De.(
- deserializer @@ fun ctx ->
- let field_visitor =
- Visitor.
- {
- default with
- visit_int =
- (fun _ctx int -> if int = 0 then Ok `A else Error `invalid_tag);
- }
- in
-
- variant ctx "simple_variant" [ "A" ] @@ fun ctx ->
- let* `A = identifier ctx field_visitor in
- let* () = unit_variant ctx in
- Ok A)
- A "A";
-
- test "variant_without_args and wrong serialization" pp_variant
- Ser.(
- serializer @@ fun A ctx ->
- unit_variant ctx "simple_variant" 199 "Wrong_variant_name")
- De.(
- deserializer @@ fun ctx ->
- let field_visitor =
- Visitor.
- {
- default with
- visit_int =
- (fun _ctx int -> if int = 0 then Ok `A else Error `invalid_tag);
- }
- in
-
- variant ctx "simple_variant" [ "A" ] @@ fun ctx ->
- let* `A = identifier ctx field_visitor in
- let* () = unit_variant ctx in
- Ok A)
- A "Exception: invalid_tag";
-
- test "variant with one arg" pp_variant_with_arg
- Ser.(
- serializer @@ fun (B i) ctx ->
- newtype_variant ctx "simple_variant" 0 "B" (int i))
- De.(
- deserializer @@ fun ctx ->
- let field_visitor =
- Visitor.
- {
- default with
- visit_int =
- (fun _ctx int -> if int = 0 then Ok `B else Error `invalid_tag);
- }
- in
-
- variant ctx "simple_variant" [ "B" ] @@ fun ctx ->
- let* `B = identifier ctx field_visitor in
- newtype_variant ctx @@ fun ctx ->
- let* i = int ctx in
- Ok (B i))
- (B 2112) "(B 2112)";
-
- test "variant with one arg and wrong serialization" pp_variant_with_arg
- Ser.(
- serializer @@ fun (B i) ctx ->
- newtype_variant ctx "simple_variant" 990 "Wrong_variant" (int i))
- De.(
- deserializer @@ fun ctx ->
- let field_visitor =
- Visitor.
- {
- default with
- visit_int =
- (fun _ctx int -> if int = 0 then Ok `B else Error `invalid_tag);
- }
- in
-
- variant ctx "simple_variant" [ "B" ] @@ fun ctx ->
- let* `B = identifier ctx field_visitor in
- newtype_variant ctx @@ fun ctx ->
- let* i = int ctx in
- Ok (B i))
- (B 2112) "Exception: invalid_tag";
-
- test "variant with many args" pp_variant_with_many_arg
- Ser.(
- serializer @@ fun (C (i, str, flt)) ctx ->
- tuple_variant ctx "variant_with_many_args" 0 "C" 3 @@ fun ctx ->
- let* () = element ctx (int i) in
- let* () = element ctx (string str) in
- let* () = element ctx (float flt) in
- Ok ())
- De.(
- deserializer @@ fun ctx ->
- let field_visitor =
- Visitor.
- {
- default with
- visit_int =
- (fun _ctx int -> if int = 0 then Ok `C else Error `invalid_tag);
- }
- in
-
- variant ctx "variant_with_many_args" [ "C" ] @@ fun ctx ->
- let* `C = identifier ctx field_visitor in
- tuple_variant ctx 3 @@ fun ~size:_ ctx ->
- let* i = element ctx int in
- let i = Option.get i in
- let* str = element ctx string in
- let str = Option.get str in
- let* flt = element ctx float in
- let flt = Option.get flt in
- Ok (C (i, str, flt)))
- (C (2112, "rush", Float.pi))
- {|(C (2112, "rush", 3.14159265359))|};
-
- test "record_with_one_arg" pp_record
- Ser.(
- serializer @@ fun r ctx ->
- record ctx "simple_record" 2 @@ fun ctx ->
- let* () = field ctx "name" (string r.name) in
- let* () = field ctx "year" (int r.year) in
- Ok ())
- De.(
- deserializer @@ fun ctx ->
- record ctx "record" 2 @@ fun ctx ->
- let* name = field ctx "name" string in
- let* year = field ctx "year" int in
- Ok { name; year })
- { name = "rush"; year = 2112 }
- {|{name="rush";year=2112}|};
-
- test "variant with inline record" pp_variant_with_inline_record
- Ser.(
- serializer @@ fun (D { is_inline }) ctx ->
- record_variant ctx "variant_with_many_args" 0 "C" 2 @@ fun ctx ->
- let* () = field ctx "is_inline" (bool is_inline) in
- Ok ())
- De.(
- deserializer @@ fun ctx ->
- let field_visitor =
- Visitor.
- {
- default with
- visit_int =
- (fun _ctx int -> if int = 0 then Ok `D else Error `invalid_tag);
- }
- in
-
- variant ctx "variant_with_many_args" [ "C" ] @@ fun ctx ->
- let* `D = identifier ctx field_visitor in
- record_variant ctx 2 @@ fun ~size:_ ctx ->
- let* is_inline = field ctx "is_inline" bool in
- Ok (D { is_inline }))
- (D { is_inline = true })
- {|(D {is_inline=true})|};
-
- test "record_with_nested_records" pp_record_nested
- Ser.(
- let nested_serializer =
- serializer @@ fun nr ctx ->
- record ctx "nested" 1 @@ fun ctx ->
- field ctx "nested_flag" (bool nr.nested_flag)
- in
- serializer @@ fun r ctx ->
- record ctx "record_nested" 1 @@ fun ctx ->
- field ctx "nested" (s nested_serializer r.nested))
- De.(
- let nested_deserializer =
- deserializer @@ fun ctx ->
- record ctx "record_nested" 1 @@ fun ctx ->
- let* nested_flag = field ctx "nested_flag" bool in
- Ok { nested_flag }
- in
- deserializer @@ fun ctx ->
- record ctx "nested" 1 @@ fun _ctx ->
- let* nested = field ctx "nested" (d nested_deserializer) in
- Ok { nested })
- { nested = { nested_flag = false } }
- {|({nested={nested_flag=false}})|};
-
- let option_serializer =
- Ser.(serializer @@ fun opt ctx -> option string opt ctx)
- in
- let option_deserializer = De.(deserializer @@ fun ctx -> option string ctx) in
- test "option/some" pp_with_option option_serializer option_deserializer
- (Some "rush" : with_option)
- {|(Some "rush")|};
-
- test "option/none" pp_with_option option_serializer option_deserializer None
- {|None|};
-
- let list_serializer =
- Ser.(
- serializer @@ fun ls ctx ->
- sequence ctx (List.length ls) @@ fun ctx ->
- List.fold_left
- (fun acc el ->
- match acc with Ok () -> element ctx (string el) | _ -> acc)
- (Ok ()) ls)
- in
-
- let list_deserializer =
- De.(
- deserializer @@ fun ctx ->
- sequence ctx @@ fun ~size ctx ->
- let rec read_elements size acc =
- if size = 0 then Ok (List.rev acc)
- else
- let* v = element ctx string in
- match v with
- | Some s -> read_elements (size - 1) (s :: acc)
- | None -> Ok (List.rev acc)
- in
- read_elements size [])
- in
- test "list/empty" pp_with_list list_serializer list_deserializer
- ([] : with_list)
- {|[]|};
-
- test "list/singleton" pp_with_list list_serializer list_deserializer
- ([ "rush" ] : with_list)
- {|["rush"]|};
-
- test "list/many" pp_with_list list_serializer list_deserializer
- ([ "rush"; "tom sawyer"; "xanadu"; "2112" ] : with_list)
- {|["rush"; "tom sawyer"; "xanadu"; "2112"]|};
-
- let array_serializer =
- Ser.(
- serializer @@ fun ls ctx ->
- sequence ctx (Array.length ls) @@ fun ctx ->
- Array.fold_left
- (fun acc el ->
- match acc with Ok () -> element ctx (string el) | _ -> acc)
- (Ok ()) ls)
- in
-
- let array_deserializer =
- De.(
- deserializer @@ fun ctx ->
- sequence ctx @@ fun ~size ctx ->
- let rec read_elements size acc =
- if size = 0 then Ok (List.rev acc)
- else
- let* v = element ctx string in
- match v with
- | Some s -> read_elements (size - 1) (s :: acc)
- | None -> Ok (List.rev acc)
- in
- let* list = read_elements size [] in
- Ok (Array.of_list list))
- in
- test "array/empty" pp_with_array array_serializer array_deserializer
- ([||] : with_array)
- {|[||]|};
-
- test "array/singleton" pp_with_array array_serializer array_deserializer
- ([| "rush" |] : with_array)
- {|[|"rush"|]|};
-
- test "array/many" pp_with_array array_serializer array_deserializer
- ([| "rush"; "tom sawyer"; "xanadu"; "2112" |] : with_array)
- {|[|"rush"; "tom sawyer"; "xanadu"; "2112"|]|};
-
- let nested_opt_ser =
- Ser.(
- serializer @@ fun r ctx ->
- record ctx "with_nested_option" 1 @@ fun ctx ->
- field ctx "nested_opt" (s option_serializer r.nested_opt))
- in
- let nested_opt_de =
- De.(
- deserializer @@ fun ctx ->
- record ctx "with_nested_option" 1 @@ fun ctx ->
- let* nested_opt = field ctx "nested_opt" option_deserializer in
- Ok { nested_opt })
- in
- test "record with nested option/none" pp_with_nested_option nested_opt_ser
- nested_opt_de { nested_opt = None } {|({nested_opt=None})|};
- test "record with nested option/some" pp_with_nested_option nested_opt_ser
- nested_opt_de
- { nested_opt = Some "rush" }
- {|({nested_opt=(Some "rush")})|};
-
- test "record_with_list" pp_record_with_list
- Ser.(
- serializer @@ fun r ctx ->
- record ctx "record_with_list" 1 @@ fun ctx ->
- let* () = field ctx "keys" (list string r.keys) in
- field ctx "collection" (string r.collection))
- De.(
- deserializer @@ fun ctx ->
- record ctx "record_with_list" 1 @@ fun ctx ->
- let* keys = field ctx "keys" (list string) in
- let* collection = field ctx "collection" string in
- Ok { keys; collection })
- { keys = [ "rush"; "genesis"; "foo fighters" ]; collection = "bands" }
- {|{keys=["rush"; "genesis"; "foo fighters"];collection="bands"}|};
-
- test "record_with_list/empty" pp_record_with_list
- Ser.(
- serializer @@ fun r ctx ->
- record ctx "record_with_list" 1 @@ fun ctx ->
- let* () = field ctx "keys" (s (list string) r.keys) in
- field ctx "collection" (string r.collection))
- De.(
- deserializer @@ fun ctx ->
- record ctx "record_with_list" 1 @@ fun ctx ->
- let* keys = field ctx "keys" (d (list string)) in
- let* collection = field ctx "collection" string in
- Ok { keys; collection })
- { keys = []; collection = "bands" }
- {|{keys=[];collection="bands"}|};
- ()
diff --git a/serde_derive.opam b/serde_derive.opam
deleted file mode 100644
index 1f73c4b..0000000
--- a/serde_derive.opam
+++ /dev/null
@@ -1,33 +0,0 @@
-# This file is generated by dune, edit dune-project instead
-opam-version: "2.0"
-synopsis: "Derive-macros for the Serde serialization framework"
-description:
- "These macros help derive serializers and deserializers for your existing types and provide all the functionality you expect to plug in different data-formats."
-maintainer: ["Leandro Ostera <leandro@abstractmachines.dev>"]
-authors: ["Leandro Ostera <leandro@abstractmachines.dev>"]
-license: "MIT"
-homepage: "https://github.com/serde-ml/serde"
-bug-reports: "https://github.com/serde-ml/serde/issues"
-depends: [
- "ocaml" {>= "5.1.1"}
- "ppx_deriving" {>= "5.2.1"}
- "ppxlib" {>= "0.28.0"}
- "serde" {= version}
- "dune" {>= "3.13"}
- "odoc" {with-doc}
-]
-build: [
- ["dune" "subst"] {dev}
- [
- "dune"
- "build"
- "-p"
- name
- "-j"
- jobs
- "@install"
- "@runtest" {with-test}
- "@doc" {with-doc}
- ]
-]
-dev-repo: "git+https://github.com/serde-ml/serde.git"
diff --git a/serde_json.opam b/serde_json.opam
index 0f80d13..836d2ca 100644
--- a/serde_json.opam
+++ b/serde_json.opam
@@ -4,8 +4,8 @@ synopsis: "JSON format support for Serde"
maintainer: ["Leandro Ostera <leandro@abstractmachines.dev>"]
authors: ["Leandro Ostera <leandro@abstractmachines.dev>"]
license: "MIT"
-homepage: "https://github.com/serde-ml/serde"
-bug-reports: "https://github.com/serde-ml/serde/issues"
+homepage: "https://github.com/serde-ml/json"
+bug-reports: "https://github.com/serde-ml/json/issues"
depends: [
"ocaml" {>= "5.1.1"}
"ppx_inline_test" {>= "v0.16.0"}
@@ -32,4 +32,4 @@ build: [
"@doc" {with-doc}
]
]
-dev-repo: "git+https://github.com/serde-ml/serde.git"
+dev-repo: "git+https://github.com/serde-ml/json.git"
diff --git a/serde_json/serde_json_test.ml b/serde_json/serde_json_test.ml
index 9a3bd55..2f196db 100644
--- a/serde_json/serde_json_test.ml
+++ b/serde_json/serde_json_test.ml
@@ -175,7 +175,7 @@ let _serde_json_roundtrip_tests =
tuple_variant ctx "variant_with_many_args" 0 "C" 3 @@ fun ctx ->
let* () = element ctx (int32 i) in
let* () = element ctx (string str) in
- let* () = element ctx (float flt) in
+ let* () = element ctx (Ser.float flt) in
Ok ())
De.(
deserializer @@ fun ctx ->