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

refactor(ppx): use pattern matching that can check exhaustively #798

Merged
merged 2 commits into from
Oct 20, 2023
Merged

refactor(ppx): use pattern matching that can check exhaustively #798

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
75a21e6
refactor(ppx): use pattern matching that can check exhaustively
anmonteiro Oct 19, 2023
5a6087a
fix: one more occurrence
anmonteiro Oct 19, 2023
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
69 changes: 32 additions & 37 deletions ppx/reason_react_ppx.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -83,9 +83,6 @@ let rec find_opt p = function
| [] -> None
| x :: l -> if p x then Some x else find_opt p l

let isOptional str = match str with Optional _ -> true | _ -> false
let isLabelled str = match str with Labelled _ -> true | _ -> false

let getLabel str =
match str with Optional str | Labelled str -> str | Nolabel -> ""

Expand Down Expand Up @@ -476,9 +473,7 @@ let jsxExprAndChildren ~ident ~loc ~ctxt mapper ~keyProps children =
(Builder.pexp_ident ~loc { loc; txt = Ldot (ident, "jsx") }, None, None)

let reactJsxExprAndChildren = jsxExprAndChildren ~ident:(Lident "React")

let reactDomJsxExprAndChildren =
jsxExprAndChildren ~ident:(Lident "ReactDOM")
let reactDomJsxExprAndChildren = jsxExprAndChildren ~ident:(Lident "ReactDOM")

(* Builds an AST node for the entire `external` definition of props *)
let makeExternalDecl fnName loc namedArgListWithKeyAndRef namedTypeList =
Expand Down Expand Up @@ -639,11 +634,14 @@ let jsxMapper =
(Invalid_argument
"Ref cannot be passed as a normal prop. Please use `forwardRef` \
API instead.")
| Pexp_fun (arg, default, pattern, expression)
when isOptional arg || isLabelled arg ->
| Pexp_fun
( ((Optional label | Labelled label) as arg),
default,
pattern,
expression ) ->
let () =
match (isOptional arg, pattern, default) with
| true, { ppat_desc = Ppat_constraint (_, { ptyp_desc }) }, None -> (
match (arg, pattern, default) with
| Optional _, { ppat_desc = Ppat_constraint (_, { ptyp_desc }) }, None -> (
match ptyp_desc with
| Ptyp_constr ({ txt = Lident "option" }, [ _ ]) -> ()
| _ ->
Expand All @@ -668,7 +666,7 @@ let jsxMapper =
match pattern with
| { ppat_desc = Ppat_alias (_, { txt }) | Ppat_var { txt } } -> txt
| { ppat_desc = Ppat_any } -> "_"
| _ -> getLabel arg
| _ -> label
in
let type_ =
match pattern with
Expand Down Expand Up @@ -705,10 +703,9 @@ let jsxMapper =
let argToType types (name, default, _noLabelName, _alias, loc, type_) =
match (type_, name, default) with
| ( Some { ptyp_desc = Ptyp_constr ({ txt = Lident "option" }, [ type_ ]) },
name,
_ )
when isOptional name ->
( getLabel name,
Optional label,
_ ) ->
( label,
[],
{
type_ with
Expand All @@ -728,8 +725,8 @@ let jsxMapper =
} )
:: types
| Some type_, name, _ -> (getLabel name, [], type_) :: types
| None, name, _ when isOptional name ->
( getLabel name,
| None, Optional label, _ ->
( label,
[],
{
ptyp_desc =
Expand All @@ -748,8 +745,8 @@ let jsxMapper =
ptyp_attributes = [];
} )
:: types
| None, name, _ when isLabelled name ->
( getLabel name,
| None, Labelled label, _ ->
( label,
[],
{
ptyp_desc = Ptyp_var (safeTypeFromValue name);
Expand All @@ -764,9 +761,9 @@ let jsxMapper =

let argToConcreteType types (name, loc, type_) =
match name with
| name when isLabelled name -> (getLabel name, [], type_) :: types
| name when isOptional name ->
( getLabel name,
| Labelled label -> (label, [], type_) :: types
| Optional label ->
( label,
[],
Builder.ptyp_constr ~loc { loc; txt = optionIdent } [ type_ ] )
:: types
Expand All @@ -789,12 +786,14 @@ let jsxMapper =
| [ _ ] ->
let rec getPropTypes types ({ ptyp_loc; ptyp_desc } as fullType) =
match ptyp_desc with
| Ptyp_arrow (name, type_, ({ ptyp_desc = Ptyp_arrow _ } as rest))
when isLabelled name || isOptional name ->
| Ptyp_arrow
( ((Labelled _ | Optional _) as name),
type_,
({ ptyp_desc = Ptyp_arrow _ } as rest) ) ->
getPropTypes ((name, ptyp_loc, type_) :: types) rest
| Ptyp_arrow (Nolabel, _type, rest) -> getPropTypes types rest
| Ptyp_arrow (name, type_, returnValue)
when isLabelled name || isOptional name ->
| Ptyp_arrow
(((Labelled _ | Optional _) as name), type_, returnValue) ->
(returnValue, (name, returnValue.ptyp_loc, type_) :: types)
| _ -> (fullType, types)
in
Expand Down Expand Up @@ -1073,14 +1072,8 @@ let jsxMapper =
| None -> namedArgList
in
let pluckArg (label, _, _, alias, loc, _) =
let labelString =
match label with
| label when isOptional label || isLabelled label ->
getLabel label
| _ -> ""
in
( label,
match labelString with
match getLabel label with
| "" -> Builder.pexp_ident ~loc { txt = Lident alias; loc }
| labelString ->
Builder.pexp_apply ~loc
Expand Down Expand Up @@ -1250,12 +1243,14 @@ let jsxMapper =
| [ _ ] ->
let rec getPropTypes types ({ ptyp_loc; ptyp_desc } as fullType) =
match ptyp_desc with
| Ptyp_arrow (name, type_, ({ ptyp_desc = Ptyp_arrow _ } as rest))
when isOptional name || isLabelled name ->
| Ptyp_arrow
( ((Labelled _ | Optional _) as name),
type_,
({ ptyp_desc = Ptyp_arrow _ } as rest) ) ->
getPropTypes ((name, ptyp_loc, type_) :: types) rest
| Ptyp_arrow (Nolabel, _type, rest) -> getPropTypes types rest
| Ptyp_arrow (name, type_, returnValue)
when isOptional name || isLabelled name ->
| Ptyp_arrow
(((Labelled _ | Optional _) as name), type_, returnValue) ->
(returnValue, (name, returnValue.ptyp_loc, type_) :: types)
| _ -> (fullType, types)
in
Expand Down
Loading