feat: add rename all

derive/attributes.ml

@@ -39,6 +39,7 @@ type field_attributes = {
 (* deserialize_ignored_any *)
 let of_record_attributes attributes =
   (* Field defaults *)
+  let rename_all = ref None in
   let deny_unknown_fields = ref false in
   (* Retrieve fields *)
   let serde_attr =
@@ -61,6 +62,28 @@ let of_record_attributes attributes =
                   deny_unknown_fields := true
               | { txt = Lident "deny_unknown_fields"; _ }, [%expr false] ->
                   deny_unknown_fields := false
+              | { txt = Lident "rename_all"; _ }, expr ->
+                  let rename_value =
+                    match expr with
+                    | [%expr "none"] -> None
+                    | [%expr "lowercase"] -> Some `lowercase
+                    | [%expr "UPPERCASE"] -> Some `UPPERCASE
+                    | [%expr "kebab-case"] -> Some `kebab_case
+                    | [%expr "camelCase"] -> Some `camelCase
+                    | [%expr "bestCase"] -> Some `camelCase
+                    | [%expr "PascalCase"] -> Some `PascalCase
+                    | [%expr "snake_case"] -> Some `snake_case
+                    | [%expr "SCREAMING_SNAKE_CASE"] ->
+                        Some `SCREAMING_SNAKE_CASE
+                    | [%expr "SCREAMING-KEBAB-CASE"] ->
+                        Some `SCREAMING_KEBAB_CASE
+                    | _ ->
+                        failwith
+                          (Format.asprintf
+                             "[ppx_serde] Unknown rename_all value '%a'"
+                             Pprintast.expression expr)
+                  in
+                  rename_all := rename_value
               | { txt = Lident txt; _ }, _ ->
                   failwith
                     (Format.sprintf "[ppx_serde] Unknown attribute %S" txt)
@@ -71,13 +94,46 @@ let of_record_attributes attributes =
   {
     rename = "";
     mode = `normal;
-    rename_all = None;
+    rename_all = !rename_all;
     deny_unknown_fields = !deny_unknown_fields;
   }
 
-let of_field_attributes lbl =
+let pascal_case field =
+  let is_underscore c = c = '_' in
+  let to_uppercase c = Char.uppercase_ascii c in
+  let rec aux chars capitalize acc =
+    match chars with
+    | [] -> List.rev acc
+    | c :: cs when is_underscore c -> aux cs true acc
+    | c :: cs when capitalize -> aux cs false (to_uppercase c :: acc)
+    | c :: cs -> aux cs capitalize (c :: acc)
+  in
+  let chars = String.to_seq field |> List.of_seq in
+  let pascal_list = aux chars true [] in
+  String.of_seq (List.to_seq pascal_list)
+
+let kebab_case field = String.map (function '_' -> '-' | c -> c) field
+
+let of_field_attributes type_attributes lbl =
   let open Ppxlib in
-  let name = ref lbl.pld_name.txt in
+  let name =
+    ref
+      (match type_attributes.rename_all with
+      | Some `lowercase -> String.lowercase_ascii lbl.pld_name.txt
+      | Some `UPPERCASE -> String.uppercase_ascii lbl.pld_name.txt
+      | Some `PascalCase -> pascal_case lbl.pld_name.txt
+      | Some `camelCase ->
+          let pascal = pascal_case lbl.pld_name.txt in
+          let start = String.sub pascal 0 1 |> String.lowercase_ascii in
+          let rest = String.sub pascal 1 (String.length pascal - 1) in
+          start ^ rest
+      | Some `snake_case -> lbl.pld_name.txt
+      | Some `kebab_case -> kebab_case lbl.pld_name.txt
+      | Some `SCREAMING_SNAKE_CASE -> String.uppercase_ascii lbl.pld_name.txt
+      | Some `SCREAMING_KEBAB_CASE ->
+          kebab_case lbl.pld_name.txt |> String.uppercase_ascii
+      | None -> lbl.pld_name.txt)
+  in
   let should_skip = ref `never in
   let presence =
     ref

derive/de.ml

@@ -140,7 +140,9 @@ module Record_deserializer = struct
     let open Attributes in
     let loc = loc ~ctxt in
     let labels = List.rev labels in
-    let labels = List.map Attributes.of_field_attributes labels in
+    let labels =
+      List.map (Attributes.of_field_attributes type_attributes) labels
+    in
 
     (* NOTE(@leostera): Generate the final assembling of the record value
 

derive/ser.ml

@@ -58,7 +58,8 @@ let rec serializer_for_type ~ctxt (core_type : Parsetree.core_type) =
 
 (** implementation *)
 
-let gen_serialize_variant_impl ~ctxt ptype_name cstr_declarations =
+let gen_serialize_variant_impl ~ctxt ptype_name type_attributes
+    cstr_declarations =
   let loc = loc ~ctxt in
   let type_name = Ast.estring ~loc ptype_name.txt in
 
@@ -110,7 +111,9 @@ let gen_serialize_variant_impl ~ctxt ptype_name cstr_declarations =
     | 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 labels =
+          List.map (Attributes.of_field_attributes type_attributes) labels
+        in
         let fields =
           List.map
             (fun (field, attr) ->
@@ -150,12 +153,15 @@ let gen_serialize_variant_impl ~ctxt ptype_name cstr_declarations =
 
   Ast.pexp_match ~loc [%expr t] cases
 
-let gen_serialize_record_impl ~ctxt ptype_name label_declarations =
+let gen_serialize_record_impl ~ctxt ptype_name type_attributes
+    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 labels =
+    List.map (Attributes.of_field_attributes type_attributes) labels
+  in
 
   let fields =
     List.map
@@ -185,13 +191,18 @@ let gen_serialize_impl ~ctxt type_decl =
   let loc = loc ~ctxt in
 
   let typename = type_decl.ptype_name.txt in
+  let type_attributes =
+    Attributes.of_record_attributes type_decl.ptype_attributes
+  in
 
   let body =
     match type_decl with
     | { ptype_kind = Ptype_record label_declarations; ptype_name; _ } ->
-        gen_serialize_record_impl ~ctxt ptype_name label_declarations
+        gen_serialize_record_impl ~ctxt ptype_name type_attributes
+          label_declarations
     | { ptype_kind = Ptype_variant cstrs_declaration; ptype_name; _ } ->
-        gen_serialize_variant_impl ~ctxt ptype_name cstrs_declaration
+        gen_serialize_variant_impl ~ctxt ptype_name type_attributes
+          cstrs_declaration
     | { ptype_kind; ptype_name; _ } ->
         let err =
           match ptype_kind with

serde_json/dune

@@ -6,7 +6,7 @@
 (test
  (package serde_json)
  (name serde_json_test)
- (modules serde_json_test)
+ (modules serde_json_test serde_json_rename_test)
  (libraries serde_json serde qcheck spices)
  (preprocess
   (pps serde_derive)))

serde_json/serde_json_rename_test.ml

@@ -0,0 +1,132 @@
+type with_lowercase = { tEsTinG : bool }
+[@@deriving serialize, deserialize] [@@serde { rename_all = "lowercase" }]
+
+let ( let* ) = Result.bind
+
+let test_de_with_lowercase () =
+  let input = {| { "testing": true } |} in
+  match Serde_json.of_string deserialize_with_lowercase input with
+  | Ok x ->
+      assert (x.tEsTinG = true);
+      Format.printf "serde_json.ser/de test \"parsed: with_lowercase\"@."
+  | Error _ -> failwith "Could not parse"
+
+let test_ser_with_lowercase () =
+  let input = {|{"testing":true}|} in
+  let* parsed = Serde_json.of_string deserialize_with_lowercase input in
+  let* serialized = Serde_json.to_string serialize_with_lowercase parsed in
+  assert (input = serialized);
+  Format.printf "serde_json.ser/de test \"serialized: with_lowercase\"@.";
+  Ok ()
+
+type with_uppercase = { tEsTinG : bool }
+[@@deriving serialize, deserialize] [@@serde { rename_all = "UPPERCASE" }]
+
+let test_de_with_uppercase () =
+  let input = {| { "TESTING": true } |} in
+  match Serde_json.of_string deserialize_with_uppercase input with
+  | Ok x ->
+      assert (x.tEsTinG = true);
+      Format.printf "serde_json.ser/de test \"parsed: with_uppercase\"@."
+  | Error _ -> failwith "Could not parse"
+
+let test_ser_with_uppercase () =
+  let input = {|{"TESTING":true}|} in
+  let* parsed = Serde_json.of_string deserialize_with_uppercase input in
+  let* serialized = Serde_json.to_string serialize_with_uppercase parsed in
+  assert (input = serialized);
+  Format.printf "serde_json.ser/de test \"serialized: with_uppercase\"@.";
+  Ok ()
+
+type with_snakecase = { testing_field : bool }
+[@@deriving serialize, deserialize] [@@serde { rename_all = "snake_case" }]
+
+let test_de_with_snakecase () =
+  let input = {| { "testing_field": true } |} in
+  match Serde_json.of_string deserialize_with_snakecase input with
+  | Ok x ->
+      assert (x.testing_field = true);
+      Format.printf "serde_json.ser/de test \"parsed: with_snakecase\"@."
+  | Error _ -> failwith "Could not parse"
+
+type with_camelcase = { camel_case : bool }
+[@@deriving serialize, deserialize] [@@serde { rename_all = "camelCase" }]
+
+let test_de_with_camelcase () =
+  let input = {| { "camelCase": true } |} in
+  match Serde_json.of_string deserialize_with_camelcase input with
+  | Ok x ->
+      assert (x.camel_case = true);
+      Format.printf "serde_json.ser/de test \"parsed: with_camelcase\"@."
+  | Error _ -> failwith "Could not parse: with_camelcase"
+
+let test_ser_with_camelcase () =
+  let input = {|{"camelCase":true}|} in
+  let* parsed = Serde_json.of_string deserialize_with_camelcase input in
+  let* serialized = Serde_json.to_string serialize_with_camelcase parsed in
+  assert (input = serialized);
+  Format.printf "serde_json.ser/de test \"serialized: with_camelCase\"@.";
+  Ok ()
+
+type with_pascalcase = { pascal_case : bool }
+[@@deriving serialize, deserialize] [@@serde { rename_all = "PascalCase" }]
+
+let test_de_with_pascalcase () =
+  let input = {| { "PascalCase": true } |} in
+  match Serde_json.of_string deserialize_with_pascalcase input with
+  | Ok x ->
+      assert (x.pascal_case = true);
+      Format.printf "serde_json.ser/de test \"parsed: with_pascalcase\"@."
+  | Error _ -> failwith "Could not parse: with_pascalcase"
+
+type with_kebabcase = { kebab_case : bool }
+[@@deriving serialize, deserialize] [@@serde { rename_all = "kebab-case" }]
+
+let test_de_with_kebabcase () =
+  let input = {| { "kebab-case": true } |} in
+  match Serde_json.of_string deserialize_with_kebabcase input with
+  | Ok x ->
+      assert (x.kebab_case = true);
+      Format.printf "serde_json.ser/de test \"parsed: with_kebabcase\"@."
+  | Error _ -> failwith "Could not parse: with_kebabcase"
+
+type with_screamingkebabcase = { kebab_case : bool }
+[@@deriving serialize, deserialize]
+[@@serde { rename_all = "SCREAMING-KEBAB-CASE" }]
+
+let test_de_with_screamingkebabcase () =
+  let input = {| { "KEBAB-CASE": true } |} in
+  match Serde_json.of_string deserialize_with_screamingkebabcase input with
+  | Ok x ->
+      assert (x.kebab_case = true);
+      Format.printf
+        "serde_json.ser/de test \"parsed: with_screamingkebabcase\"@."
+  | Error _ -> failwith "Could not parse: with_screamingkebabcase"
+
+type with_screamingsnakecase = { snake_case : bool }
+[@@deriving serialize, deserialize]
+[@@serde { rename_all = "SCREAMING_SNAKE_CASE" }]
+
+let test_de_with_screamingsnakecase () =
+  let input = {| { "SNAKE_CASE": true } |} in
+  match Serde_json.of_string deserialize_with_screamingsnakecase input with
+  | Ok x ->
+      assert (x.snake_case = true);
+      Format.printf
+        "serde_json.ser/de test \"parsed: with_screamingsnakecase\"@."
+  | Error _ -> failwith "Could not parse: with_screamingsnakecase"
+
+let run () =
+  test_de_with_lowercase ();
+  test_de_with_uppercase ();
+  test_de_with_snakecase ();
+  test_de_with_camelcase ();
+  test_de_with_pascalcase ();
+  test_de_with_kebabcase ();
+  test_de_with_screamingkebabcase ();
+  test_de_with_screamingsnakecase ();
+
+  test_ser_with_lowercase () |> Result.get_ok;
+  test_ser_with_uppercase () |> Result.get_ok;
+  test_ser_with_camelcase () |> Result.get_ok;
+  ()

serde_json/serde_json_test.ml

@@ -557,3 +557,6 @@ let _serde_json_parse_deny_unknown_fields =
       Format.printf "serde_json.ser/de test %S %s\r\n%!"
         "parsed with deny unknown keys"
         (keyword "OK: (found %a)" Serde.pp_err err)
+
+(* Leo, maybe you have a better idea *)
+let () = Serde_json_rename_test.run ()