Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

allow locally abstract type and type constraint on component definitions #151

Merged
merged 4 commits into from
Mar 15, 2022
Merged

allow locally abstract type and type constraint on component definitions #151

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
b2376ae
ppx: allow locally abstract type in component definition
glennsl Feb 25, 2022
787cd90
ppx: allow type constraint on component definitions
glennsl Feb 25, 2022
c2e8601
ppx: use Location.raise_errorf instead of invalid_arg in a few more p…
glennsl Feb 25, 2022
f7a708d
style: formatting
glennsl Mar 15, 2022
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
46 changes: 24 additions & 22 deletions ppx/ppx.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -80,10 +80,9 @@ let extractChildren ?(removeLastPositionUnit = false) ~loc propsAndChildren =
| [ (Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) })
] ->
acc
| (Nolabel, _) :: _rest ->
raise
(Invalid_argument
"JSX: found non-labelled argument before the last position")
| (Nolabel, { pexp_loc }) :: _rest ->
Location.raise_errorf ~loc:pexp_loc
"JSX: found non-labelled argument before the last position"
| arg :: rest -> allButLast_ rest (arg :: acc)
in
let allButLast lst = allButLast_ lst [] |> List.rev in
Expand All @@ -98,9 +97,9 @@ let extractChildren ?(removeLastPositionUnit = false) ~loc propsAndChildren =
, if removeLastPositionUnit then allButLast props else props )
| [ (_, childrenExpr) ], props ->
(childrenExpr, if removeLastPositionUnit then allButLast props else props)
| _ ->
raise
(Invalid_argument "JSX: somehow there's more than one `children` label")
| _first :: (_, { pexp_loc }) :: _rest, _props ->
Location.raise_errorf ~loc:pexp_loc
"JSX: somehow there's more than one `children` label"

let unerasableIgnore loc =
{ attr_name = { txt = "warning"; loc }
Expand Down Expand Up @@ -139,22 +138,22 @@ let filter_attr_name key attr =
else false

(* Finds the name of the variable the binding is assigned to, otherwise raises Invalid_argument *)
let getFnName binding =
match binding with
| { pvb_pat = { ppat_desc = Ppat_var { txt } } } -> txt
| _ ->
raise (Invalid_argument "react.component calls cannot be destructured.")
let rec getFnName = function
| { ppat_desc = Ppat_var { txt } } -> txt
| { ppat_desc = Ppat_constraint (pat, _) } -> getFnName pat
| { ppat_loc } ->
Location.raise_errorf ~loc:ppat_loc
"react.component calls cannot be destructured."

(* Lookup the value of `props` otherwise raise Invalid_argument error *)
let getPropsNameValue _acc (loc, exp) =
match (loc, exp) with
| { txt = Lident "props" }, { pexp_desc = Pexp_ident { txt = Lident str } } ->
{ propsName = str }
| { txt }, _ ->
raise
(Invalid_argument
("react.component only accepts props as an option, given: "
^ Longident.last_exn txt))
| { txt; loc }, _ ->
Location.raise_errorf ~loc
"react.component only accepts props as an option, given: %s"
(Longident.last_exn txt)

(* Lookup the `props` record or string as part of [@react.component] and store the name for use when rewriting *)
let get_props_attr payload =
Expand All @@ -174,10 +173,9 @@ let get_props_attr payload =
}
:: _rest)) ->
{ propsName = "props" }
| Some (PStr ({ pstr_desc = Pstr_eval (_, _) } :: _rest)) ->
raise
(Invalid_argument
"react.component accepts a record config with props as an options.")
| Some (PStr ({ pstr_desc = Pstr_eval (_, _); pstr_loc } :: _rest)) ->
Location.raise_errorf ~loc:pstr_loc
"react.component accepts a record config with props as an options."
| _ -> default_props

(* Plucks the label, loc, and type_ from an AST node *)
Expand Down Expand Up @@ -657,7 +655,7 @@ let process_value_binding ~pstr_loc ~inside_component ~mapper binding =
if has_attr_on_binding binding || inside_component then
let binding_loc = binding.pvb_loc in
let binding_pat_loc = binding.pvb_pat.ppat_loc in
let fn_name = getFnName binding in
let fn_name = getFnName binding.pvb_pat in
let modified_binding_old binding =
let expression = binding.pvb_expr in
(* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *)
Expand All @@ -681,6 +679,10 @@ let process_value_binding ~pstr_loc ~inside_component ~mapper binding =
spelunk_for_fun_expr inner_fun_expr
| { pexp_desc = Pexp_sequence (_wrapper_expr, inner_fun_expr) } ->
spelunk_for_fun_expr inner_fun_expr
| { pexp_desc = Pexp_newtype (_label, inner_fun_expr) } ->
spelunk_for_fun_expr inner_fun_expr
| { pexp_desc = Pexp_constraint (inner_fun_expr, _typ) } ->
spelunk_for_fun_expr inner_fun_expr
| exp ->
Location.raise_errorf ~loc:exp.pexp_loc
"react.component calls can only be on function definitions or \
Expand Down
2 changes: 2 additions & 0 deletions ppx/test/input_ocaml.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,8 @@ let%component make ~children:kids = div [||] kids
let%component make ~children:(first, second) () = div [||] [ first; second ]
let%component make ?(name = "") = div [||] [ name ]
let%component make () = div [||] []
let%component make (type a) ~(foo : a) : _ = div [||] []
let%component make : type a. foo:a -> _ = fun ~foo:_ -> div [||] []

let%component make ~(bar : int option) =
div [||] [ React.string (string_of_int (Option.value ~default:0 bar)) ] ()
Expand Down
67 changes: 67 additions & 0 deletions ppx/test/pp_ocaml.expected
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -222,6 +222,73 @@ let make =
((let make (Props : < > Js_of_ocaml.Js.t) = make () in
fun ?key -> fun () -> React.create_element make (make_props ?key ()))
[@merlin.hide ])
let make =
let make_props
: foo:a ->
?key:string ->
unit -> < foo: a Js_of_ocaml.Js.readonly_prop > Js_of_ocaml.Js.t
=
fun ~foo ->
fun ?key ->
fun () ->
let open Js_of_ocaml.Js.Unsafe in
obj
[|("key",
(inject
(Js_of_ocaml.Js.Optdef.option
(Option.map Js_of_ocaml.Js.string key))));("foo",
(
inject
foo))|]
[@@merlin.hide ] in
let make (type a) ~foo:(foo : a) = (div [||] [] : _) in
((let make
(Props : < foo: a Js_of_ocaml.Js.readonly_prop > Js_of_ocaml.Js.t) =
make
~foo:(fun (type res) -> fun (type a0) ->
fun (a0 : a0 Js_of_ocaml.Js.t) ->
fun (_ : a0 -> < get: res ;.. > Js_of_ocaml.Js.gen_prop)
-> (Js_of_ocaml.Js.Unsafe.get a0 "foo" : res)
(Props : < .. > Js_of_ocaml.Js.t) (fun x -> x#foo)) in
fun ~foo ->
fun ?key ->
fun () -> React.create_element make (make_props ?key ~foo ()))
[@merlin.hide ])
let make =
let make_props
: foo:'foo ->
?key:string ->
unit ->
< foo: 'foo Js_of_ocaml.Js.readonly_prop > Js_of_ocaml.Js.t
=
fun ~foo ->
fun ?key ->
fun () ->
let open Js_of_ocaml.Js.Unsafe in
obj
[|("key",
(inject
(Js_of_ocaml.Js.Optdef.option
(Option.map Js_of_ocaml.Js.string key))));("foo",
(
inject
foo))|]
[@@merlin.hide ] in
let make (type a) = (fun ~foo:_ -> div [||] [] : foo:a -> _) in
((let make
(Props :
< foo: 'foo Js_of_ocaml.Js.readonly_prop > Js_of_ocaml.Js.t)
=
make
~foo:(fun (type res) -> fun (type a0) ->
fun (a0 : a0 Js_of_ocaml.Js.t) ->
fun (_ : a0 -> < get: res ;.. > Js_of_ocaml.Js.gen_prop)
-> (Js_of_ocaml.Js.Unsafe.get a0 "foo" : res)
(Props : < .. > Js_of_ocaml.Js.t) (fun x -> x#foo)) in
fun ~foo ->
fun ?key ->
fun () -> React.create_element make (make_props ?key ~foo ()))
[@merlin.hide ])
let make =
let make_props
: bar:int option ->
Expand Down