Utilize Js.Json.Boolean(bool) instead oif Js.Json.True, False (#58)

green-labs · Oct 11, 2023 · a190663 · a190663
1 parent 3aa3d73
commit a190663
Show file tree

Hide file tree

Showing 41 changed files with 804 additions and 2,377 deletions.
diff --git a/examples/package.json b/examples/package.json
@@ -4,7 +4,7 @@
   "description": "Examples for the Spice PPX",
   "license": "MIT",
   "devDependencies": {
-    "rescript": "11.0.0-beta.3"
+    "rescript": "^11.0.0-rc.4"
   },
   "scripts": {
     "res:build": "rescript",

diff --git a/examples/bsconfig.json → examples/rescript.json b/examples/bsconfig.json → examples/rescript.json
diff --git a/examples/src/Advanced.js b/examples/src/Advanced.js
diff --git a/examples/src/Basic.js b/examples/src/Basic.js
diff --git a/examples/src/CustomCodecs.js b/examples/src/CustomCodecs.js
diff --git a/examples/src/CustomCodecs2.js b/examples/src/CustomCodecs2.js
diff --git a/examples/src/CustomCodecs3.js b/examples/src/CustomCodecs3.js
diff --git a/examples/src/Tuple.js b/examples/src/Tuple.js
diff --git a/examples/src/UntaggedVariant.js b/examples/src/UntaggedVariant.js
diff --git a/examples/src/Variants.js b/examples/src/Variants.js
diff --git a/examples/src/Variants2.js b/examples/src/Variants2.js
diff --git a/examples/yarn.lock b/examples/yarn.lock
@@ -1441,10 +1441,10 @@ require-main-filename@^2.0.0:
   resolved "https://registry.yarnpkg.com/require-main-filename/-/require-main-filename-2.0.0.tgz#d0b329ecc7cc0f61649f62215be69af54aa8989b"
   integrity sha512-NKN5kMDylKuldxYLSUfrbo5Tuzh4hd+2E8NPPX02mZtn1VuREQToYe/ZdlJy+J3uCpfaiGF05e7B8W0iXbQHmg==
 
-[email protected]beta.3:
-  version "11.0.0-beta.3"
-  resolved "https://registry.yarnpkg.com/rescript/-/rescript-11.0.0-beta.3.tgz#f883a19aa8cb2ab162fd2c9f3d46d2c05cc5710b"
-  integrity sha512-j3YT3VdWMoHgwL4RydKJm9O/VIpN3NTI6keP18rZVJ8ansRKgkHYGLaIwoG6iVqSYYwBjb6d8l8oZ1Jz0fmTeQ==
+rescript@^11.0.0-rc.4:
+  version "11.0.0-rc.4"
+  resolved "https://registry.yarnpkg.com/rescript/-/rescript-11.0.0-rc.4.tgz#a7db18239a342dcda586c6f65ba5e6e4298d8d72"
+  integrity sha512-yh82o30J2/B/IwyPZjM+mc82FdyPkXRjXxlsUVEoyc5Z/snlq3Za2PhJhlfacwk+ui5lcOZsH8SndWPiI21vXg==
 
 resolve-from@^5.0.0:
   version "5.0.0"

diff --git a/src/ppx/curried/codecs_curried.ml b/src/ppx/curried/codecs_curried.ml
@@ -65,15 +65,15 @@ and generate_constr_codecs { do_encode; do_decode }
         if do_decode then Some [%expr fun v -> Belt.Result.Ok v] else None )
   | Lident s ->
       ( (if do_encode then Some (make_ident_expr (s ^ Utils.encoder_func_suffix))
-        else None),
+         else None),
         if do_decode then Some (make_ident_expr (s ^ Utils.decoder_func_suffix))
         else None )
   | Ldot (left, right) ->
       ( (if do_encode then
-         Some
-           (Exp.ident
-              (mknoloc (Ldot (left, right ^ Utils.encoder_func_suffix))))
-        else None),
+           Some
+             (Exp.ident
+                (mknoloc (Ldot (left, right ^ Utils.encoder_func_suffix))))
+         else None),
         if do_decode then
           Some
             (Exp.ident
@@ -93,11 +93,11 @@ and generate_codecs ({ do_encode; do_decode } as generator_settings)
         List.map (generate_codecs generator_settings) types
       in
       ( (if do_encode then
-         Some
-           (composite_codecs
-           |> List.map (fun (e, _) -> Option.get e)
-           |> Tuple.generate_encoder)
-        else None),
+           Some
+             (composite_codecs
+             |> List.map (fun (e, _) -> Option.get e)
+             |> Tuple.generate_encoder)
+         else None),
         if do_decode then
           Some
             (composite_codecs
@@ -106,7 +106,7 @@ and generate_codecs ({ do_encode; do_decode } as generator_settings)
         else None )
   | Ptyp_var s ->
       ( (if do_encode then Some (make_ident_expr (encoder_var_prefix ^ s))
-        else None),
+         else None),
         if do_decode then Some (make_ident_expr (decoder_var_prefix ^ s))
         else None )
   | Ptyp_constr (constr, typeArgs) -> (
@@ -117,11 +117,11 @@ and generate_codecs ({ do_encode; do_decode } as generator_settings)
         | Ok (Some attribute) ->
             let expr = get_expression_from_payload attribute in
             ( (if do_encode then
-               Some
-                 [%expr
-                   let e, _ = [%e expr] in
-                   e]
-              else None),
+                 Some
+                   [%expr
+                     let e, _ = [%e expr] in
+                     e]
+               else None),
               if do_decode then
                 Some
                   [%expr

diff --git a/src/ppx/curried/signature_curried.ml b/src/ppx/curried/signature_curried.ml
@@ -0,0 +1,86 @@
+open Ppxlib
+open Parsetree
+open Utils
+
+let rec add_encoder_params param_names result_type =
+  match param_names with
+  | [] -> result_type
+  | hd :: tl ->
+      [%type: ([%t Ast_helper.Typ.var hd] -> Js.Json.t) -> [%t result_type]]
+      |> add_encoder_params tl
+
+let make_result_type value_type =
+  [%type: ([%t value_type], Spice.decodeError) Belt.Result.t]
+
+let rec add_decoder_params param_names result_type =
+  match param_names with
+  | [] -> result_type
+  | hd :: tl ->
+      let decoder_param =
+        [%type: Js.Json.t -> [%t make_result_type (Ast_helper.Typ.var hd)]]
+      in
+      [%type: [%t decoder_param] -> [%t result_type]] |> add_decoder_params tl
+
+let generate_sig_decls { do_encode; do_decode } type_name param_names =
+  let encoder_pat = type_name ^ Utils.encoder_func_suffix in
+  let decoder_pat = type_name ^ Utils.decoder_func_suffix in
+  let value_type =
+    param_names
+    |> List.map Ast_helper.Typ.var
+    |> Ast_helper.Typ.constr (lid type_name)
+  in
+
+  let decls = [] in
+
+  let decls =
+    match do_encode with
+    | true ->
+        decls
+        @ [
+            [%type: [%t value_type] -> Js.Json.t]
+            |> add_encoder_params (List.rev param_names)
+            |> Ast_helper.Val.mk (mknoloc encoder_pat)
+            |> Ast_helper.Sig.value;
+          ]
+    | false -> decls
+  in
+  let decls =
+    match do_decode with
+    | true ->
+        decls
+        @ [
+            [%type: Js.Json.t -> [%t make_result_type value_type]]
+            |> add_decoder_params (List.rev param_names)
+            |> Ast_helper.Val.mk (mknoloc decoder_pat)
+            |> Ast_helper.Sig.value;
+          ]
+    | false -> decls
+  in
+
+  decls
+
+let map_type_decl decl =
+  let {
+    ptype_attributes;
+    ptype_name = { txt = type_name };
+    ptype_params;
+    ptype_loc;
+  } =
+    decl
+  in
+
+  match get_generator_settings_from_attributes ptype_attributes with
+  | Error s -> fail ptype_loc s
+  | Ok None -> []
+  | Ok (Some generator_settings) ->
+      generate_sig_decls generator_settings type_name
+        (get_param_names ptype_params)
+
+let map_signature_item mapper ({ psig_desc } as signature_item) =
+  match psig_desc with
+  | Psig_type (_, decls) ->
+      let generated_sig_items =
+        decls |> List.map map_type_decl |> List.concat
+      in
+      mapper#signature_item signature_item :: generated_sig_items
+  | _ -> [ mapper#signature_item signature_item ]