@greenlabs/ppx-spice 0.1.8 → 0.1.9-rc1

package/src/ppx/tuple.ml

@@ -1,68 +0,0 @@
-open Ppxlib
-open Parsetree
-open Ast_helper
-open Utils
-
-let generate_encoder composite_encoders =
-  let arrExp =
-    composite_encoders
-    |> List.mapi (fun i e ->
-           let vExp = Exp.ident (lid ("v" ^ string_of_int i)) in
-           [%expr [%e e] [%e vExp]])
-    |> Exp.array
-  in
-  let deconstructor_pattern =
-    composite_encoders
-    |> List.mapi (fun i _ -> Pat.var (mknoloc ("v" ^ string_of_int i)))
-    |> Pat.tuple
-  in
-  [%expr fun [%p deconstructor_pattern] -> [%e arrExp] |> Js.Json.array]
-
-let generate_decode_success_case num_args =
-  {
-    pc_lhs =
-      Array.init num_args (fun i ->
-          mknoloc ("v" ^ string_of_int i) |> Pat.var |> fun p ->
-          [%pat? Belt.Result.Ok [%p p]])
-      |> Array.to_list
-      |> tuple_or_singleton Pat.tuple;
-    pc_guard = None;
-    pc_rhs =
-      ( Array.init num_args (fun i -> make_ident_expr ("v" ^ string_of_int i))
-      |> Array.to_list |> Exp.tuple
-      |> fun e -> [%expr Belt.Result.Ok [%e e]] );
-  }
-
-let generate_decode_switch composite_decoders =
-  let decode_expr =
-    composite_decoders
-    |> List.mapi (fun i d ->
-           let ident = make_ident_expr ("v" ^ string_of_int i) in
-           [%expr [%e d] [%e ident]])
-    |> Exp.tuple
-  in
-  composite_decoders
-  |> List.mapi
-       (Decode_cases.generate_error_case (List.length composite_decoders))
-  |> List.append
-       [ generate_decode_success_case (List.length composite_decoders) ]
-  |> Exp.match_ decode_expr
-
-let generate_decoder composite_decoders =
-  let match_arr_pattern =
-    composite_decoders
-    |> List.mapi (fun i _ -> Pat.var (mknoloc ("v" ^ string_of_int i)))
-    |> Pat.array
-  in
-  let match_pattern = [%pat? Js.Json.JSONArray [%p match_arr_pattern]] in
-  let outer_switch =
-    Exp.match_ [%expr Js.Json.classify json]
-      [
-        Exp.case match_pattern (generate_decode_switch composite_decoders);
-        Exp.case
-          [%pat? Js.Json.JSONArray _]
-          [%expr Spice.error "Incorrect cardinality" json];
-        Exp.case [%pat? _] [%expr Spice.error "Not a tuple" json];
-      ]
-  in
-  [%expr fun json -> [%e outer_switch]]

package/src/ppx/utils.ml

@@ -1,117 +0,0 @@
-open Ppxlib
-open Parsetree
-open Ast_helper
-
-let annotation_name = "spice"
-
-let encoder_func_suffix = "_encode"
-
-let decoder_func_suffix = "_decode"
-
-let encoder_var_prefix = "encoder_"
-
-let decoder_var_prefix = "decoder_"
-
-let loc = !default_loc
-
-let fail loc message = Location.raise_errorf ~loc "%s" message
-
-let longident_parse = Longident.parse [@@ocaml.warning "-3"]
-
-let mkloc txt loc = { Location.txt; loc }
-
-let mknoloc txt = mkloc txt Location.none
-
-let lid ?(loc = Location.none) s = mkloc (Longident.parse s) loc
-
-let make_ident_expr ?attrs s = Exp.ident ?attrs (mknoloc (longident_parse s))
-
-let tuple_or_singleton tuple l =
-  match List.length l > 1 with true -> tuple l | false -> List.hd l
-
-let get_attribute_by_name attributes name =
-  let filtered =
-    attributes
-    |> List.filter (fun { attr_name = { Location.txt } } -> txt = name)
-  in
-  match filtered with
-  | [] -> Ok None
-  | [ attribute ] -> Ok (Some attribute)
-  | _ -> Error ("Too many occurrences of \"" ^ name ^ "\" attribute")
-
-type generator_settings = { do_encode : bool; do_decode : bool }
-
-let get_generator_settings_from_attributes attributes =
-  match get_attribute_by_name attributes annotation_name with
-  | Ok None -> (
-      match
-        ( get_attribute_by_name attributes (annotation_name ^ ".decode"),
-          get_attribute_by_name attributes (annotation_name ^ ".encode") )
-      with
-      | Ok (Some _), Ok (Some _) ->
-          Ok (Some { do_encode = true; do_decode = true })
-      | Ok (Some _), Ok None ->
-          Ok (Some { do_encode = false; do_decode = true })
-      | Ok None, Ok (Some _) ->
-          Ok (Some { do_encode = true; do_decode = false })
-      | Ok None, Ok None -> Ok None
-      | (Error _ as e), _ -> e
-      | _, (Error _ as e) -> e)
-  | Ok (Some _) -> Ok (Some { do_encode = true; do_decode = true })
-  | Error _ as e -> e
-
-let get_expression_from_payload { attr_name = { loc }; attr_payload = payload }
-    =
-  match payload with
-  | PStr [ { pstr_desc } ] -> (
-      match pstr_desc with
-      | Pstr_eval (expr, _) -> expr
-      | _ -> fail loc "Expected expression as attribute payload")
-  | _ -> fail loc "Expected expression as attribute payload"
-
-let get_param_names params =
-  params
-  |> List.map (fun ({ ptyp_desc; ptyp_loc }, _) ->
-         match ptyp_desc with
-         | Ptyp_var s -> s
-         | _ ->
-             fail ptyp_loc "Unhandled param type" |> fun v ->
-             Location.Error v |> raise)
-
-let get_string_from_expression { pexp_desc; pexp_loc } =
-  match pexp_desc with
-  | Pexp_constant const -> (
-      match const with
-      | Pconst_string (name, loc, delimit) -> (name, loc, delimit)
-      | _ -> fail pexp_loc "cannot find a name??")
-  | _ -> fail pexp_loc "cannot find a name??"
-
-let index_const i =
-  Pconst_string ("[" ^ string_of_int i ^ "]", Location.none, None)
-  |> Exp.constant
-
-let rec is_identifier_used_in_core_type type_name { ptyp_desc; ptyp_loc } =
-  match ptyp_desc with
-  | Ptyp_arrow (_, _, _) ->
-      fail ptyp_loc "Can't generate codecs for function type"
-  | Ptyp_any -> fail ptyp_loc "Can't generate codecs for `any` type"
-  | Ptyp_package _ -> fail ptyp_loc "Can't generate codecs for module type"
-  | Ptyp_variant (_, _, _) -> fail ptyp_loc "Unexpected Ptyp_variant"
-  | Ptyp_var _ -> false
-  | Ptyp_tuple child_types ->
-      List.exists (is_identifier_used_in_core_type type_name) child_types
-  | Ptyp_constr ({ txt }, child_types) -> (
-      match txt = Lident type_name with
-      | true -> true
-      | false ->
-          List.exists (is_identifier_used_in_core_type type_name) child_types)
-  | _ -> fail ptyp_loc "This syntax is not yet handled by spice"
-
-let attr_warning expr =
-  {
-    attr_name = mkloc "ocaml.warning" loc;
-    attr_payload = PStr [ { pstr_desc = Pstr_eval (expr, []); pstr_loc = loc } ];
-    attr_loc = loc;
-  }
-
-let some_if_true cond a = match cond with true -> Some a | false -> None

package/src/ppx/variants.ml

@@ -1,257 +0,0 @@
-open Ppxlib
-open Parsetree
-open Ast_helper
-open Utils
-
-type parsed_decl = {
-  name : string;
-  alias : expression;
-  has_attr_as : bool;
-  constr_decl : Parsetree.constructor_declaration;
-}
-
-let generate_encoder_case generator_settings unboxed has_attr_as
-    { name; alias; constr_decl = { pcd_args; pcd_loc } } =
-  match pcd_args with
-  | Pcstr_tuple args ->
-      let alias_name, _, delimit = get_string_from_expression alias in
-      let constructor_expr =
-        Exp.constant (Pconst_string (alias_name, Location.none, delimit))
-      in
-      let lhs_vars =
-        match args with
-        | [] -> None
-        | [ _ ] -> Some (Pat.var (mknoloc "v0"))
-        | _ ->
-            args
-            |> List.mapi (fun i _ ->
-                   mkloc ("v" ^ string_of_int i) pcd_loc |> Pat.var)
-            |> Pat.tuple
-            |> fun v -> Some v
-      in
-      let rhs_list =
-        args
-        |> List.map (Codecs.generate_codecs generator_settings)
-        |> List.map (fun (encoder, _) -> Option.get encoder)
-        |> List.mapi (fun i e ->
-               Exp.apply ~loc:pcd_loc e
-                 [ (Asttypes.Nolabel, make_ident_expr ("v" ^ string_of_int i)) ])
-        |> List.append [ [%expr Js.Json.string [%e constructor_expr]] ]
-      in
-
-      {
-        pc_lhs = Pat.construct (lid name) lhs_vars;
-        pc_guard = None;
-        pc_rhs =
-          (if unboxed then List.tl rhs_list |> List.hd
-          else if has_attr_as then [%expr Js.Json.string [%e constructor_expr]]
-          else [%expr Js.Json.array [%e rhs_list |> Exp.array]]);
-      }
-  | Pcstr_record _ -> fail pcd_loc "This syntax is not yet implemented by spice"
-
-let generate_decode_success_case num_args constructor_name =
-  {
-    pc_lhs =
-      Array.init num_args (fun i ->
-          mknoloc ("v" ^ string_of_int i) |> Pat.var |> fun p ->
-          [%pat? Belt.Result.Ok [%p p]])
-      |> Array.to_list
-      |> tuple_or_singleton Pat.tuple;
-    pc_guard = None;
-    pc_rhs =
-      ( Array.init num_args (fun i -> make_ident_expr ("v" ^ string_of_int i))
-      |> Array.to_list
-      |> tuple_or_singleton Exp.tuple
-      |> fun v ->
-        Some v |> Exp.construct (lid constructor_name) |> fun e ->
-        [%expr Belt.Result.Ok [%e e]] );
-  }
-
-let generate_arg_decoder generator_settings args constructor_name =
-  let num_args = List.length args in
-  args
-  |> List.mapi (Decode_cases.generate_error_case num_args)
-  |> List.append [ generate_decode_success_case num_args constructor_name ]
-  |> Exp.match_
-       (args
-       |> List.map (Codecs.generate_codecs generator_settings)
-       |> List.mapi (fun i (_, decoder) ->
-              Exp.apply (Option.get decoder)
-                [
-                  ( Asttypes.Nolabel,
-                    (* +1 because index 0 is the constructor *)
-                    let idx =
-                      Pconst_integer (string_of_int (i + 1), None)
-                      |> Exp.constant
-                    in
-                    [%expr Belt.Array.getExn json_arr [%e idx]] );
-                ])
-       |> tuple_or_singleton Exp.tuple)
-
-let generate_decoder_case generator_settings
-    { pcd_name = { txt = name }; pcd_args; pcd_loc } =
-  match pcd_args with
-  | Pcstr_tuple args ->
-      let arg_len =
-        Pconst_integer (string_of_int (List.length args + 1), None)
-        |> Exp.constant
-      in
-      let decoded =
-        match args with
-        | [] ->
-            let ident = lid name in
-            [%expr Belt.Result.Ok [%e Exp.construct ident None]]
-        | _ -> generate_arg_decoder generator_settings args name
-      in
-
-      {
-        pc_lhs =
-          ( Pconst_string (name, Location.none, None) |> Pat.constant |> fun v ->
-            Some v |> Pat.construct (lid "Js.Json.JSONString") );
-        pc_guard = None;
-        pc_rhs =
-          [%expr
-            if Js.Array.length tagged <> [%e arg_len] then
-              Spice.error "Invalid number of arguments to variant constructor" v
-            else [%e decoded]];
-      }
-  | Pcstr_record _ -> fail pcd_loc "This syntax is not yet implemented by spice"
-
-let generate_decoder_case_attr generator_settings
-    { name; alias; constr_decl = { pcd_args; pcd_loc } } =
-  match pcd_args with
-  | Pcstr_tuple args ->
-      let alias_name, _, delimit = get_string_from_expression alias in
-      let decoded =
-        match args with
-        | [] ->
-            let ident = lid name in
-            [%expr Belt.Result.Ok [%e Exp.construct ident None]]
-        | _ -> generate_arg_decoder generator_settings args name
-      in
-
-      let if' =
-        Exp.apply (make_ident_expr "=")
-          [
-            ( Asttypes.Nolabel,
-              Pconst_string (alias_name, Location.none, delimit) |> Exp.constant
-            );
-            (Asttypes.Nolabel, [%expr str]);
-          ]
-      in
-      let then' = [%expr [%e decoded]] in
-
-      (if', then')
-  | Pcstr_record _ -> fail pcd_loc "This syntax is not yet implemented by spice"
-
-let generate_unboxed_decode generator_settings
-    { pcd_name = { txt = name }; pcd_args; pcd_loc } =
-  match pcd_args with
-  | Pcstr_tuple args -> (
-      match args with
-      | [ a ] -> (
-          let _, d = Codecs.generate_codecs generator_settings a in
-          match d with
-          | Some d ->
-              let constructor = Exp.construct (lid name) (Some [%expr v]) in
-
-              Some
-                [%expr
-                  fun v ->
-                    Belt.Result.map ([%e d] v) (fun v -> [%e constructor])]
-          | None -> None)
-      | _ -> fail pcd_loc "Expected exactly one type argument")
-  | Pcstr_record _ -> fail pcd_loc "This syntax is not yet implemented by spice"
-
-let parse_decl _generator_settings
-    ({ pcd_name = { txt }; pcd_loc; pcd_attributes } as constr_decl) =
-  let alias, has_attr_as =
-    match get_attribute_by_name pcd_attributes "spice.as" with
-    | Ok (Some attribute) -> (get_expression_from_payload attribute, true)
-    | Ok None -> (Exp.constant (Pconst_string (txt, Location.none, None)), false)
-    | Error s -> (fail pcd_loc s, false)
-  in
-
-  { name = txt; alias; has_attr_as; constr_decl }
-
-let generate_codecs ({ do_encode; do_decode } as generator_settings)
-    constr_decls unboxed =
-  let parsed_decls = List.map (parse_decl generator_settings) constr_decls in
-  let count_has_attr =
-    parsed_decls |> List.filter (fun v -> v.has_attr_as) |> List.length
-  in
-  let has_attr_as =
-    if count_has_attr > 0 then
-      if count_has_attr = List.length parsed_decls then true
-      else failwith "Partial @spice.as usage is not allowed"
-    else false
-  in
-
-  let encoder =
-    some_if_true do_encode
-      (parsed_decls
-      |> List.map (generate_encoder_case generator_settings unboxed has_attr_as)
-      |> Exp.match_ [%expr v]
-      |> Exp.fun_ Asttypes.Nolabel None [%pat? v])
-  in
-
-  let decoder =
-    match not do_decode with
-    | true -> None
-    | false ->
-        if unboxed then
-          generate_unboxed_decode generator_settings (List.hd constr_decls)
-        else if has_attr_as then
-          let rec make_ifthenelse cases =
-            match cases with
-            | [] -> [%expr Spice.error "Not matched" v]
-            | hd :: tl ->
-                let if_, then_ = hd in
-                Exp.ifthenelse if_ then_ (Some (make_ifthenelse tl))
-          in
-
-          let decoder_switch =
-            List.map
-              (generate_decoder_case_attr generator_settings)
-              parsed_decls
-            |> make_ifthenelse
-          in
-
-          Some
-            [%expr
-              fun v ->
-                match Js.Json.classify v with
-                | Js.Json.JSONString str -> [%e decoder_switch]
-                | _ -> Spice.error "Not a JSONString" v]
-        else
-          let decoder_default_case =
-            {
-              pc_lhs = [%pat? _];
-              pc_guard = None;
-              pc_rhs =
-                [%expr
-                  Spice.error "Invalid variant constructor"
-                    (Belt.Array.getExn json_arr 0)];
-            }
-          in
-
-          let decoder_switch =
-            constr_decls |> List.map (generate_decoder_case generator_settings)
-            |> fun l ->
-            l @ [ decoder_default_case ]
-            |> Exp.match_ [%expr Belt.Array.getExn tagged 0]
-          in
-
-          Some
-            [%expr
-              fun v ->
-                match Js.Json.classify v with
-                | Js.Json.JSONArray [||] ->
-                    Spice.error "Expected variant, found empty array" v
-                | Js.Json.JSONArray json_arr ->
-                    let tagged = Js.Array.map Js.Json.classify json_arr in
-                    [%e decoder_switch]
-                | _ -> Spice.error "Not a variant" v]
-  in
-
-  (encoder, decoder)

package/src/ppx_spice.opam

@@ -1,21 +0,0 @@
-opam-version: "2.0"
-name: "ppx_spice"
-version: "0.1.8"
-synopsis: "ReScript PPX which generate JSON (de)serializer"
-description: """
-ReScript PPX which generate JSON (de)serializer
-"""
-maintainer: "Greenlabs Dev <developer@greenlabs.co.kr>"
-authors: "Greenlabs Dev <developer@greenlabs.co.kr>"
-license: "MIT"
-homepage: "https://github.com/green-labs/ppx_spice"
-bug-reports: "https://github.com/green-labs/ppx_spice/issues"
-dev-repo: "git+https://github.com/green-labs/ppx_spice.git"
-depends: [
-  "ocaml" { = "4.12.1"}
-  "dune" { >= "2.7"}
-  "ppxlib" { = "0.23.0"}
-]
-build: [
-  ["dune" "build" "-p" name "-j" jobs]
-]

package/test/__tests__/test_optional_field_records.js

@@ -1,91 +0,0 @@
-// Generated by ReScript, PLEASE EDIT WITH CARE
-'use strict';
-
-var Jest = require("@glennsl/bs-jest/src/jest.js");
-var OptionalFieldRecords = require("../src/OptionalFieldRecords.js");
-
-Jest.describe("optional field record", (function (param) {
-        var sample = {};
-        sample["a"] = 1;
-        sample["b"] = 1;
-        var sampleRecord = {
-          a: 1,
-          b: 1
-        };
-        Jest.test("encode", (function (param) {
-                var encoded = OptionalFieldRecords.t0_encode(sampleRecord);
-                return Jest.Expect.toEqual(sample, Jest.Expect.expect(encoded));
-              }));
-        Jest.test("decode", (function (param) {
-                var decoded = OptionalFieldRecords.t0_decode(sample);
-                return Jest.Expect.toEqual({
-                            TAG: /* Ok */0,
-                            _0: sampleRecord
-                          }, Jest.Expect.expect(decoded));
-              }));
-      }));
-
-Jest.describe("optional field record: array<int>", (function (param) {
-        var sample = {};
-        sample["a"] = 1;
-        sample["bs"] = [1];
-        var sampleRecord_bs = [1];
-        var sampleRecord = {
-          a: 1,
-          bs: sampleRecord_bs
-        };
-        Jest.test("encode", (function (param) {
-                var encoded = OptionalFieldRecords.t1_encode(sampleRecord);
-                return Jest.Expect.toEqual(sample, Jest.Expect.expect(encoded));
-              }));
-        Jest.test("decode", (function (param) {
-                var decoded = OptionalFieldRecords.t1_decode(sample);
-                return Jest.Expect.toEqual({
-                            TAG: /* Ok */0,
-                            _0: sampleRecord
-                          }, Jest.Expect.expect(decoded));
-              }));
-      }));
-
-Jest.describe("optional field record: array<variant>", (function (param) {
-        var sample = {};
-        sample["a"] = 1;
-        sample["bs"] = ["B1"];
-        var sampleRecord_bs = [/* B1 */1];
-        var sampleRecord = {
-          a: 1,
-          bs: sampleRecord_bs
-        };
-        Jest.test("encode", (function (param) {
-                var encoded = OptionalFieldRecords.t2_encode(sampleRecord);
-                return Jest.Expect.toEqual(sample, Jest.Expect.expect(encoded));
-              }));
-        Jest.test("decode", (function (param) {
-                var decoded = OptionalFieldRecords.t2_decode(sample);
-                return Jest.Expect.toEqual({
-                            TAG: /* Ok */0,
-                            _0: sampleRecord
-                          }, Jest.Expect.expect(decoded));
-              }));
-      }));
-
-Jest.describe("optional field record: omit array<variant>", (function (param) {
-        var sample = {};
-        sample["a"] = 1;
-        var sampleRecord = {
-          a: 1
-        };
-        Jest.test("encode", (function (param) {
-                var encoded = OptionalFieldRecords.t2_encode(sampleRecord);
-                return Jest.Expect.toEqual(sample, Jest.Expect.expect(encoded));
-              }));
-        Jest.test("decode", (function (param) {
-                var decoded = OptionalFieldRecords.t2_decode(sample);
-                return Jest.Expect.toEqual({
-                            TAG: /* Ok */0,
-                            _0: sampleRecord
-                          }, Jest.Expect.expect(decoded));
-              }));
-      }));
-
-/*  Not a pure module */

package/test/__tests__/test_optional_field_records.res

@@ -1,98 +0,0 @@
-open Jest
-open Expect
-// open Belt
-
-describe("optional field record", _ => {
-  open OptionalFieldRecords
-
-  let sample = Js.Dict.empty()
-  sample->Js.Dict.set("a", Js.Json.number(1.))
-  sample->Js.Dict.set("b", Js.Json.number(1.))
-  let sampleJson = sample->Js.Json.object_
-
-  let sampleRecord: t0 = {
-    a: 1,
-    b: 1,
-  }
-
-  test(`encode`, _ => {
-    let encoded = sampleRecord->t0_encode
-    expect(encoded) |> toEqual(sampleJson)
-  })
-
-  test(`decode`, _ => {
-    let decoded = sampleJson->t0_decode
-    expect(decoded) |> toEqual(Belt.Result.Ok(sampleRecord))
-  })
-})
-
-describe("optional field record: array<int>", _ => {
-  open OptionalFieldRecords
-
-  let sample = Js.Dict.empty()
-  sample->Js.Dict.set("a", Js.Json.number(1.))
-  sample->Js.Dict.set("bs", Js.Json.array([Js.Json.number(1.)]))
-  let sampleJson = sample->Js.Json.object_
-
-  let sampleRecord: t1 = {
-    a: 1,
-    bs: [1],
-  }
-
-  test(`encode`, _ => {
-    let encoded = sampleRecord->t1_encode
-    expect(encoded) |> toEqual(sampleJson)
-  })
-
-  test(`decode`, _ => {
-    let decoded = sampleJson->t1_decode
-    expect(decoded) |> toEqual(Belt.Result.Ok(sampleRecord))
-  })
-})
-
-describe("optional field record: array<variant>", _ => {
-  open OptionalFieldRecords
-
-  let sample = Js.Dict.empty()
-  sample->Js.Dict.set("a", Js.Json.number(1.))
-  sample->Js.Dict.set("bs", Js.Json.array([Js.Json.string("B1")]))
-  let sampleJson = sample->Js.Json.object_
-
-  let sampleRecord: t2 = {
-    a: 1,
-    bs: [B1],
-  }
-
-  test(`encode`, _ => {
-    let encoded = sampleRecord->t2_encode
-    expect(encoded) |> toEqual(sampleJson)
-  })
-
-  test(`decode`, _ => {
-    let decoded = sampleJson->t2_decode
-    expect(decoded) |> toEqual(Belt.Result.Ok(sampleRecord))
-  })
-})
-
-describe("optional field record: omit array<variant>", _ => {
-  open OptionalFieldRecords
-
-  let sample = Js.Dict.empty()
-  sample->Js.Dict.set("a", Js.Json.number(1.))
-
-  let sampleJson = sample->Js.Json.object_
-
-  let sampleRecord: t2 = {
-    a: 1,
-  }
-
-  test(`encode`, _ => {
-    let encoded = sampleRecord->t2_encode
-    expect(encoded) |> toEqual(sampleJson)
-  })
-
-  test(`decode`, _ => {
-    let decoded = sampleJson->t2_decode
-    expect(decoded) |> toEqual(Belt.Result.Ok(sampleRecord))
-  })
-})