Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion examples/decode.ml
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@
let mapJsonObjectString f decoder (encoder : int -> Js.Json.t) str =
let json = Melange_json.of_string str in
Melange_json.Of_json.(js_dict decoder json)
|> Js.Dict.map ~f:(fun [@u] v -> f v)
|> Js.Dict.map ~f:(fun[@u] v -> f v)
|> Melange_json.To_json.js_dict encoder
|> Melange_json.to_string

Expand Down
3 changes: 0 additions & 3 deletions ppx/native/common/ppx_deriving_json_common.ml
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,6 @@ let get_of_variant_case ?mark_as_seen ~variant ~polyvariant = function
| Vcs_ctx_variant ctx -> Attribute.get ?mark_as_seen variant ctx
| Vcs_ctx_polyvariant ctx -> Attribute.get ?mark_as_seen polyvariant ctx


let get_of_variant ?mark_as_seen ~variant ~polyvariant = function
| Vrt_ctx_variant ctx -> Attribute.get ?mark_as_seen variant ctx
| Vrt_ctx_polyvariant ctx -> Attribute.get ?mark_as_seen polyvariant ctx
Expand All @@ -24,8 +23,6 @@ let vcs_attr_json_name =
let polyvariant = attr_json_name Attribute.Context.rtag in
get_of_variant_case ~variant ~polyvariant



let attr_json_allow_any ctx = Attribute.declare_flag "json.allow_any" ctx

let vcs_attr_json_allow_any =
Expand Down
14 changes: 7 additions & 7 deletions ppx/native/common/ppx_deriving_tools.ml
Original file line number Diff line number Diff line change
Expand Up @@ -409,7 +409,7 @@ module Conv = struct
let allow_any_constr =
cs
|> List.find_opt ~f:(fun cs ->
is_allow_any_constr (Vcs_ctx_variant cs))
is_allow_any_constr (Vcs_ctx_variant cs))
|> Option.map (fun cs e -> econstruct cs (Some e))
in
let cs =
Expand Down Expand Up @@ -479,13 +479,13 @@ module Conv = struct
let allow_any_constr =
cs
|> List.find_opt ~f:(fun cs ->
is_allow_any_constr (Vcs_ctx_polyvariant cs))
is_allow_any_constr (Vcs_ctx_polyvariant cs))
|> Option.map (fun cs ->
match cs.prf_desc with
| Rinherit _ ->
failwith "[@allow_any] placed on inherit clause"
| Rtag (n, _, _) ->
fun e -> pexp_variant ~loc:n.loc n.txt (Some e))
match cs.prf_desc with
| Rinherit _ ->
failwith "[@allow_any] placed on inherit clause"
| Rtag (n, _, _) ->
fun e -> pexp_variant ~loc:n.loc n.txt (Some e))
in
let cs =
List.filter
Expand Down
35 changes: 17 additions & 18 deletions ppx/native/ppx_deriving_json_native.ml
Original file line number Diff line number Diff line change
Expand Up @@ -195,24 +195,23 @@ module To_json = struct
let e =
List.combine t.rcd_fields es
|> List.fold_left ~init:ebnds ~f:(fun acc (ld, x) ->
let key =
Option.value ~default:ld.pld_name (ld_attr_json_key ld)
in
let k = estring ~loc:key.loc key.txt in
let v = derive ld.pld_type x in
let ebnds =
match ld_drop_default ld with
| `No -> [%expr ([%e k], [%e v]) :: [%e ebnds]]
| `Drop_option ->
[%expr
match [%e x] with
| Stdlib.Option.None -> [%e ebnds]
| Stdlib.Option.Some _ ->
([%e k], [%e v]) :: [%e ebnds]]
in
[%expr
let [%p pbnds] = [%e ebnds] in
[%e acc]])
let key =
Option.value ~default:ld.pld_name (ld_attr_json_key ld)
in
let k = estring ~loc:key.loc key.txt in
let v = derive ld.pld_type x in
let ebnds =
match ld_drop_default ld with
| `No -> [%expr ([%e k], [%e v]) :: [%e ebnds]]
| `Drop_option ->
[%expr
match [%e x] with
| Stdlib.Option.None -> [%e ebnds]
| Stdlib.Option.Some _ -> ([%e k], [%e v]) :: [%e ebnds]]
in
[%expr
let [%p pbnds] = [%e ebnds] in
[%e acc]])
in
[%expr
`Assoc
Expand Down
Loading