From da60cf3f59b8e34878e9bfa469f3fed6df46967b Mon Sep 17 00:00:00 2001 From: Alex Fedoseev Date: Sat, 22 Feb 2020 15:16:02 +0000 Subject: [PATCH] (wip) [@field.collection] --- lib/ppx/Ast.re | 8 +- lib/ppx/AstHelpers.re | 326 ++- lib/ppx/Form.re | 193 +- lib/ppx/Form_ActionType.re | 153 +- lib/ppx/Form_CollectionsStatusesType.re | 34 + lib/ppx/Form_FieldsStatusesType.re | 80 +- lib/ppx/Form_InitialCollectionsStatuses.re | 26 + lib/ppx/Form_InitialFieldsStatusesFn.re | 47 +- lib/ppx/Form_InitialStateFn.re | 1 + lib/ppx/Form_InterfaceType.re | 210 +- lib/ppx/Form_StateType.re | 1 + lib/ppx/Form_UseFormFn.re | 10 +- .../Form_UseFormFn_ApplyAsyncResultActions.re | 87 +- lib/ppx/Form_UseFormFn_BlurActions.re | 175 +- lib/ppx/Form_UseFormFn_BlurActions_Async.re | 80 - .../Form_UseFormFn_BlurActions_AsyncField.re | 139 + ...> Form_UseFormFn_BlurActions_SyncField.re} | 27 +- lib/ppx/Form_UseFormFn_CollectionsActions.re | 204 ++ lib/ppx/Form_UseFormFn_Interface.re | 397 ++- lib/ppx/Form_UseFormFn_RestActions.re | 6 +- lib/ppx/Form_UseFormFn_UpdateActions.re | 362 ++- ...Fn_UpdateActions_AsyncFieldInOnBlurMode.re | 128 + ..._UpdateActions_AsyncFieldInOnChangeMode.re | 141 + ...UseFormFn_UpdateActions_AsyncOnBlurMode.re | 67 - ...eFormFn_UpdateActions_AsyncOnChangeMode.re | 80 - ...UseFormFn_UpdateActions_DependentFields.re | 230 ++ lib/ppx/Form_UseFormFn_UpdateActions_Deps.re | 66 - lib/ppx/Form_UseFormFn_UpdateActions_Sync.re | 42 - .../Form_UseFormFn_UpdateActions_SyncField.re | 58 + lib/ppx/Form_ValidateFormFn.re | 949 +++++++ lib/ppx/Form_ValidateFormFn_Async.re | 345 --- lib/ppx/Form_ValidateFormFn_Sync.re | 217 -- lib/ppx/Form_ValidatorsRecord.re | 395 ++- lib/ppx/Form_ValidatorsType.re | 148 +- lib/ppx/Meta.re | 2286 +++++++++++++---- lib/ppx/Ppx.re | 11 +- lib/ppx/Printer.re | 74 + lib/src/Formality.re | 536 +++- 38 files changed, 6386 insertions(+), 1953 deletions(-) create mode 100644 lib/ppx/Form_CollectionsStatusesType.re create mode 100644 lib/ppx/Form_InitialCollectionsStatuses.re delete mode 100644 lib/ppx/Form_UseFormFn_BlurActions_Async.re create mode 100644 lib/ppx/Form_UseFormFn_BlurActions_AsyncField.re rename lib/ppx/{Form_UseFormFn_BlurActions_Sync.re => Form_UseFormFn_BlurActions_SyncField.re} (54%) create mode 100644 lib/ppx/Form_UseFormFn_CollectionsActions.re create mode 100644 lib/ppx/Form_UseFormFn_UpdateActions_AsyncFieldInOnBlurMode.re create mode 100644 lib/ppx/Form_UseFormFn_UpdateActions_AsyncFieldInOnChangeMode.re delete mode 100644 lib/ppx/Form_UseFormFn_UpdateActions_AsyncOnBlurMode.re delete mode 100644 lib/ppx/Form_UseFormFn_UpdateActions_AsyncOnChangeMode.re create mode 100644 lib/ppx/Form_UseFormFn_UpdateActions_DependentFields.re delete mode 100644 lib/ppx/Form_UseFormFn_UpdateActions_Deps.re delete mode 100644 lib/ppx/Form_UseFormFn_UpdateActions_Sync.re create mode 100644 lib/ppx/Form_UseFormFn_UpdateActions_SyncField.re create mode 100644 lib/ppx/Form_ValidateFormFn.re delete mode 100644 lib/ppx/Form_ValidateFormFn_Async.re delete mode 100644 lib/ppx/Form_ValidateFormFn_Sync.re create mode 100644 lib/ppx/Printer.re diff --git a/lib/ppx/Ast.re b/lib/ppx/Ast.re index f629333b..10e904f7 100644 --- a/lib/ppx/Ast.re +++ b/lib/ppx/Ast.re @@ -1,17 +1,11 @@ open Ppxlib; open Ast_helper; -let lid = (~loc, x: Longident.t) => {txt: x, loc}; let str = (~loc, x: string) => {txt: x, loc}; +let lid = (~loc, x: Longident.t) => {txt: x, loc}; let explicit_arity = (~loc) => { attr_name: "explicit_arity" |> str(~loc), attr_payload: PStr([]), attr_loc: Location.none, }; - -module StructureItem = { - let from_type_declaration = - (~loc: Location.t, ~rec_flag: rec_flag, decl: type_declaration) => - Str.type_(~loc, rec_flag, [decl]); -}; diff --git a/lib/ppx/AstHelpers.re b/lib/ppx/AstHelpers.re index 7d391ee7..9a483f2c 100644 --- a/lib/ppx/AstHelpers.re +++ b/lib/ppx/AstHelpers.re @@ -14,37 +14,15 @@ module T = { }, x |> str(~loc), ); +}; - let record_of_fields = - ( - ~name, - ~loc, - ~typ: - (~validator: FieldValidator.t, ~output_type: FieldType.t) => - core_type, - scheme: Scheme.t, - ) => - name - |> str(~loc) - |> Type.mk( - ~kind= - Ptype_record( - scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field(field) => - Type.field( - field.name |> str(~loc), - typ( - ~validator=field.validator, - ~output_type=field.output_type, - ), - ) - } - ), - ), - ) - |> StructureItem.from_type_declaration(~loc, ~rec_flag=Recursive); +module P = { + let rec or_ = (~pat, ~make, list) => + switch (list) { + | [] => pat + | [x] => x |> make |> Pat.or_(pat) + | [x, ...rest] => rest |> or_(~pat=x |> make |> Pat.or_(pat), ~make) + }; }; module E = { @@ -55,12 +33,6 @@ module E = { Some(Exp.tuple([x])), ); - let ref_ = (~loc, x) => - Exp.apply( - Exp.ident(Lident("!") |> lid(~loc)), - [(Nolabel, Exp.ident(Lident(x) |> lid(~loc)))], - ); - let rec seq = (~exp, ~make, list) => switch (list) { | [] => exp @@ -69,57 +41,134 @@ module E = { rest |> seq(~exp=x |> make |> Exp.sequence(exp), ~make) }; - let field = (~of_ as record, ~loc, field: Field.t) => + let rec conj = (~exp, ~make, ~loc, list) => + switch (list) { + | [] => exp + | [x] => + Exp.apply( + Exp.ident(Lident("&&") |> lid(~loc)), + [(Nolabel, exp), (Nolabel, x |> make(~loc))], + ) + | [x, ...rest] => + rest + |> conj( + ~exp= + Exp.apply( + Exp.ident(Lident("&&") |> lid(~loc)), + [(Nolabel, exp), (Nolabel, x |> make(~loc))], + ), + ~make, + ~loc, + ) + }; + + let ref_ = (~loc, x) => + Exp.apply( + Exp.ident(Lident("!") |> lid(~loc)), + [(Nolabel, Exp.ident(Lident(x) |> lid(~loc)))], + ); + + let record = (~loc, xs: list((string, expression))) => + Exp.record( + xs |> List.map(((name, expr)) => (Lident(name) |> lid(~loc), expr)), + None, + ); + + let field = (~of_ as record, ~loc, field) => Exp.field( Exp.ident(Lident(record) |> lid(~loc)), - switch (field) { - | Field(field) => Lident(field) |> lid(~loc) - }, + Lident(field) |> lid(~loc), ); - let field2 = (~of_ as (record1, record2), ~loc, field: Field.t) => + let field2 = (~of_ as (record1, record2), ~loc, field) => Exp.field( Exp.field( Exp.ident(Lident(record1) |> lid(~loc)), Lident(record2) |> lid(~loc), ), - switch (field) { - | Field(field) => Lident(field) |> lid(~loc) - }, + Lident(field) |> lid(~loc), + ); + + let field3 = (~of_ as (record1, record2, record3), ~loc, field) => + Exp.field( + Exp.field( + Exp.field( + Exp.ident(Lident(record1) |> lid(~loc)), + Lident(record2) |> lid(~loc), + ), + Lident(record3) |> lid(~loc), + ), + Lident(field) |> lid(~loc), + ); + + let field_in_collection = + (~of_, ~collection: Collection.t, ~loc, field_name) => + Exp.field( + Exp.apply( + [%expr Belt.Array.getUnsafe], + [ + (Nolabel, collection.plural |> field(~of_, ~loc)), + (Nolabel, [%expr index]), + ], + ), + Lident(field_name) |> lid(~loc), + ); + + let field_in_collection2 = + (~of_, ~collection: Collection.t, ~loc, field_name) => + Exp.field( + Exp.apply( + [%expr Belt.Array.getUnsafe], + [ + (Nolabel, collection.plural |> field2(~of_, ~loc)), + (Nolabel, [%expr index]), + ], + ), + Lident(field_name) |> lid(~loc), + ); + + let field_of_collection_validator = + (~validators, ~collection: Collection.t, ~loc, field) => + field |> field3(~of_=(validators, collection.plural, "fields"), ~loc); + + let ref_field = (~of_ as record, ~loc, field) => + Exp.field(record |> ref_(~loc), Lident(field) |> lid(~loc)); + + let ref_field2 = (~of_ as (record1, record2), ~loc, field) => + Exp.field( + Exp.field(record1 |> ref_(~loc), Lident(record2) |> lid(~loc)), + Lident(field) |> lid(~loc), ); - let ref_field = (~of_ as record, ~loc, field: Field.t) => + let ref_field_in_collection = + (~of_ as record, ~collection: Collection.t, ~loc, field_name) => Exp.field( - record |> ref_(~loc), - switch (field) { - | Field(field) => Lident(field) |> lid(~loc) - }, + Exp.apply( + [%expr Belt.Array.getUnsafe], + [ + ( + Nolabel, + Exp.field( + record |> ref_(~loc), + Lident(collection.plural) |> lid(~loc), + ), + ), + (Nolabel, [%expr index]), + ], + ), + Lident(field_name) |> lid(~loc), ); - let update_field = (~of_ as record, ~with_ as value, ~loc, field: Field.t) => + let update_field = (~of_ as record, ~with_ as value, ~loc, field) => Exp.record( - [ - ( - switch (field) { - | Field(field) => Lident(field) |> lid(~loc) - }, - value, - ), - ], + [(Lident(field) |> lid(~loc), value)], Some(Exp.ident(Lident(record) |> lid(~loc))), ); let update_field2 = - (~of_ as (record1, record2), ~with_ as value, ~loc, field: Field.t) => + (~of_ as (record1, record2), ~with_ as value, ~loc, field) => Exp.record( - [ - ( - switch (field) { - | Field(field) => Lident(field) |> lid(~loc) - }, - value, - ), - ], + [(Lident(field) |> lid(~loc), value)], Some( Exp.field( Exp.ident(Lident(record1) |> lid(~loc)), @@ -128,23 +177,146 @@ module E = { ), ); - let update_ref_field = - (~of_ as record, ~with_ as value, ~loc, field: Field.t) => + let update_field3 = + (~of_ as (record1, record2, record3), ~with_ as value, ~loc, field) => + Exp.record( + [(Lident(field) |> lid(~loc), value)], + Some( + Exp.field( + Exp.field( + Exp.ident(Lident(record1) |> lid(~loc)), + Lident(record2) |> lid(~loc), + ), + Lident(record3) |> lid(~loc), + ), + ), + ); + + let update_ref_field = (~of_ as record, ~with_ as value, ~loc, field) => + Exp.record( + [(Lident(field) |> lid(~loc), value)], + Some(record |> ref_(~loc)), + ); + + let update_ref_field2 = + (~of_ as (record1, record2), ~with_ as value, ~loc, field) => + Exp.record( + [(Lident(field) |> lid(~loc), value)], + Some( + Exp.field(record1 |> ref_(~loc), Lident(record2) |> lid(~loc)), + ), + ); + + let update_field_in_collection = + ( + ~of_ as record, + ~collection: Collection.t, + ~with_ as value, + ~loc, + field_name, + ) => Exp.record( [ ( - switch (field) { - | Field(field) => Lident(field) |> lid(~loc) - }, - value, + Lident(collection.plural) |> lid(~loc), + Exp.apply( + [%expr Belt.Array.mapWithIndex], + [ + (Nolabel, collection.plural |> field(~of_=record, ~loc)), + ( + Nolabel, + [%expr + (index', item) => + if (index' == index) { + %e + field_name + |> update_field(~of_="item", ~with_=value, ~loc); + } else { + item; + } + ], + ), + ], + ), ), ], - Some(record |> ref_(~loc)), + Some(Exp.ident(Lident(record) |> lid(~loc))), ); - let record = (~loc, xs: list((string, expression))) => + let update_field_in_collection2 = + ( + ~of_ as (record1, record2), + ~collection: Collection.t, + ~with_ as value, + ~loc, + field_name, + ) => Exp.record( - xs |> List.map(((name, expr)) => (Lident(name) |> lid(~loc), expr)), - None, + [ + ( + Lident(collection.plural) |> lid(~loc), + Exp.apply( + [%expr Belt.Array.mapWithIndex], + [ + ( + Nolabel, + collection.plural |> field2(~of_=(record1, record2), ~loc), + ), + ( + Nolabel, + [%expr + (index', item) => + if (index' == index) { + %e + field_name + |> update_field(~of_="item", ~with_=value, ~loc); + } else { + item; + } + ], + ), + ], + ), + ), + ], + Some(record2 |> field(~of_=record1, ~loc)), + ); + + let update_ref_field_in_collection = + ( + ~of_ as record, + ~collection: Collection.t, + ~with_ as value, + ~index_token="index", + ~loc, + field_name, + ) => + Exp.record( + [ + ( + Lident(collection.plural) |> lid(~loc), + Exp.apply( + [%expr Belt.Array.mapWithIndex], + [ + (Nolabel, collection.plural |> ref_field(~of_=record, ~loc)), + ( + Nolabel, + [%expr + (idx_, item) => + if (idx_ + == [%e Exp.ident(Lident(index_token) |> lid(~loc))]) { + %e + field_name + |> update_field(~of_="item", ~with_=value, ~loc); + } else { + item; + } + ], + ), + ], + ), + ), + ], + Some(record |> ref_(~loc)), ); }; diff --git a/lib/ppx/Form.re b/lib/ppx/Form.re index 6ac81313..8c8956c4 100644 --- a/lib/ppx/Form.re +++ b/lib/ppx/Form.re @@ -17,17 +17,18 @@ let ext = | Ok({ scheme, async, + collections, output_type, message_type, submission_error_type, validators_record, debounce_interval, }) => - // Once we gathered all required metadata and ensured that requirements are met + // Once all required metadata is gathered and ensured that requirements are met // We need to iterate over user provided config and do the following: // 1. Open Formality module at the top of the generated module - // 2. Inject types and values that either - // optional and weren't provided or just generated by ppx + // 2. Inject types and values that either optional and weren't provided + // or just generated by ppx // 3. Update validators record (see Form_ValidatorsRecord for details) // 4. Append neccessary functions including useForm hook // @@ -41,6 +42,7 @@ let ext = let types = ref([ Form_FieldsStatusesType.ast(~loc, scheme), + Form_CollectionsStatusesType.ast(~loc, collections), Form_StateType.ast(~loc), Form_ActionType.ast(~loc, scheme), Form_ValidatorsType.ast(~loc, scheme), @@ -75,11 +77,12 @@ let ext = let funcs = [ Form_InitialFieldsStatusesFn.ast(~loc, scheme), + Form_InitialCollectionsStatuses.ast(~loc, collections), Form_InitialStateFn.ast(~loc), async - ? Form_ValidateFormFn_Async.ast(~loc, scheme) - : Form_ValidateFormFn_Sync.ast(~loc, scheme), - Form_UseFormFn.ast(~loc, ~async, scheme), + ? Form_ValidateFormFn.Async.ast(~loc, scheme) + : Form_ValidateFormFn.Sync.ast(~loc, scheme), + Form_UseFormFn.ast(~loc, ~async, ~collections, scheme), ]; let structure: structure = @@ -133,42 +136,144 @@ let ext = Location.raise_errorf(~loc, "`input` type not found") | Error(InputTypeParseError(NotRecord(loc))) => Location.raise_errorf(~loc, "`input` must be of record type") - | Error(InputTypeParseError(InvalidAsyncField(InvalidPayload(loc)))) => + | Error( + InputTypeParseError( + InvalidAttributes( + InvalidAsyncField(InvalidPayload(loc)) | + InvalidCollectionField(InvalidAsyncField(InvalidPayload(loc))), + ), + ), + ) => Location.raise_errorf( ~loc, "`@field.async` attribute accepts only optional record `{mode: OnChange | OnBlur}`", ) - | Error(InputTypeParseError(InvalidAsyncField(InvalidAsyncMode(loc)))) => + | Error( + InputTypeParseError( + InvalidAttributes( + InvalidAsyncField(InvalidAsyncMode(loc)) | + InvalidCollectionField( + InvalidAsyncField(InvalidAsyncMode(loc)), + ), + ), + ), + ) => Location.raise_errorf( ~loc, "Invalid async mode. Use either `OnChange` or `OnBlur`.", ) - | Error(InputTypeParseError(InvalidFieldDeps(DepsParseError(loc)))) => + | Error( + InputTypeParseError( + InvalidAttributes( + InvalidFieldDeps(DepsParseError(loc)) | + InvalidCollectionField(InvalidFieldDeps(DepsParseError(loc))), + ), + ), + ) => Location.raise_errorf( ~loc, "`@field.deps` attribute must contain field or tuple of fields", ) | Error( InputTypeParseError( - InvalidFieldDeps(DepNotFound(`Field(dep, loc))), + InvalidAttributes( + InvalidFieldDeps(DepNotFound(dep)) | + InvalidCollectionField(InvalidFieldDeps(DepNotFound(dep))), + ), ), ) => - Location.raise_errorf(~loc, "Field `%s` doesn't exist in input", dep) + let (field, loc) = + switch (dep) { + | UnvalidatedDepField({name, loc}) => (name, loc) + | UnvalidatedDepFieldOfCollection({collection, field, f_loc}) => ( + collection ++ "." ++ field, + f_loc, + ) + }; + Location.raise_errorf( + ~loc, + "Field `%s` doesn't exist in input", + field, + ); | Error( InputTypeParseError( - InvalidFieldDeps(DepOfItself(`Field(dep, loc))), + InvalidAttributes( + InvalidFieldDeps(DepOfItself(`Field(name, loc))) | + InvalidCollectionField( + InvalidFieldDeps(DepOfItself(`Field(name, loc))), + ), + ), ), ) => - Location.raise_errorf(~loc, "Field `%s` depends on itself", dep) + Location.raise_errorf(~loc, "Field `%s` depends on itself", name) | Error( InputTypeParseError( - InvalidFieldDeps(DepDuplicate(`Field(dep, loc))), + InvalidAttributes( + InvalidFieldDeps(DepDuplicate(dep)) | + InvalidCollectionField(InvalidFieldDeps(DepDuplicate(dep))), + ), ), ) => + let (field, loc) = + switch (dep) { + | UnvalidatedDepField({name, loc}) => (name, loc) + | UnvalidatedDepFieldOfCollection({collection, field, f_loc}) => ( + collection ++ "." ++ field, + f_loc, + ) + }; Location.raise_errorf( ~loc, "Field `%s` is already declared as a dependency for this field", - dep, + field, + ); + | Error( + InputTypeParseError( + InvalidAttributes(Conflict(`AsyncWithCollection(loc))), + ), + ) => + Location.raise_errorf( + ~loc, + "Collection can not be `async`. If you want to make specific fields in collection async, you can apply `field.async` attribute to specific fields.", + ) + | Error( + InputTypeParseError( + InvalidAttributes(Conflict(`DepsWithCollection(loc))), + ), + ) => + Location.raise_errorf(~loc, "Collection can not have deps") + | Error( + InputTypeParseError( + InvalidAttributes(InvalidCollectionField(NotArray(loc))), + ), + ) => + Location.raise_errorf(~loc, "Collection must be an array of records") + | Error( + InputTypeParseError( + InvalidAttributes(InvalidCollectionField(InvalidTypeRef(loc))), + ), + ) => + Location.raise_errorf( + ~loc, + "Collection must be an array of records. Record type of collection entry must be defined within this module.", + ) + | Error( + InputTypeParseError( + InvalidAttributes(InvalidCollectionField(RecordNotFound(loc))), + ), + ) => + Location.raise_errorf( + ~loc, + "This type can not be found. Record type of collection entry must be defined within this module.", + ) + | Error( + InputTypeParseError( + InvalidAttributes(InvalidCollectionField(NotRecord(loc))), + ), + ) => + Location.raise_errorf( + ~loc, + "Type of collection entry must be a record", ) | Error(OutputTypeParseError(NotRecord(loc))) => Location.raise_errorf( @@ -180,6 +285,34 @@ let ext = ~loc, "`output` can only be an alias of `input` type or a record", ) + | Error(OutputTypeParseError(InputNotAvailable(loc))) => + Location.raise_errorf( + ~loc, + "`input` type is not found or in invalid state", + ) + | Error( + OutputTypeParseError( + OutputCollectionNotFound({input_collection, loc}), + ), + ) => + Location.raise_errorf( + ~loc, + "`output` type for %s collection that is defined in `input` is not found or in invalid state", + input_collection.plural, + ) + | Error( + OutputTypeParseError( + InvalidCollection( + InvalidCollectionTypeRef(loc) | CollectionTypeNotRecord(loc) | + CollectionTypeNotFound(loc) | + CollectionOutputNotArray(loc), + ), + ), + ) => + Location.raise_errorf( + ~loc, + "Collection must be an array of records. Record type of collection entry must be defined within this module.", + ) | Error(ValidatorsRecordParseError(NotFound)) => Location.raise_errorf(~loc, "`validators` record not found") | Error( @@ -207,7 +340,9 @@ let ext = ~loc, "Validator for `%s` field is required because its input and output types are different. So validator function is required to produce value of output type from an input value.", switch (field) { - | Field(field) => field + | ValidatedInputField(field) => field.name + | ValidatedInputFieldOfCollection({collection, field}) => + collection.singular ++ "." ++ field.name }, ) | `IncludedInDeps(in_deps_of_field) => @@ -215,10 +350,14 @@ let ext = ~loc, "Validator for `%s` field is required because this field is included in deps of `%s` field", switch (field) { - | Field(field) => field + | ValidatedInputField(field) => field.name + | ValidatedInputFieldOfCollection({collection, field}) => + collection.singular ++ "." ++ field.name }, switch (in_deps_of_field) { - | Field(field) => field + | ValidatedInputField(field) => field.name + | ValidatedInputFieldOfCollection({collection, field}) => + collection.singular ++ "." ++ field.name }, ) } @@ -228,13 +367,15 @@ let ext = failwith( "Empty list of non-matched fields in IOMatchError(OutputFieldsNotInInput)", ) - | [(field, loc)] - | [(field, loc), ..._] => + | [field] + | [field, ..._] => Location.raise_errorf( ~loc, "`output` field `%s` doesn't exist in `input` type", switch (field) { - | Field(field) => field + | OutputField(field) => field.name + | OutputFieldOfCollection({collection, field}) => + collection.singular ++ "." ++ field.name }, ) } @@ -256,7 +397,9 @@ let ext = ~loc, "`input` field `%s` doesn't exist in `output` type", switch (field) { - | Field(field) => field + | ValidatedInputField(field) => field.name + | ValidatedInputFieldOfCollection({collection, field}) => + collection.singular ++ "." ++ field.name }, ) | fields => @@ -264,9 +407,11 @@ let ext = ~loc, "Some `input` fields don't exist in `output` type: %s", fields - |> List.map((field: Field.t) => + |> List.map((field: InputField.validated) => switch (field) { - | Field(field) => field + | ValidatedInputField(field) => field.name + | ValidatedInputFieldOfCollection({collection, field}) => + collection.singular ++ "." ++ field.name } ) |> String.concat(", "), diff --git a/lib/ppx/Form_ActionType.re b/lib/ppx/Form_ActionType.re index 3c3eed7a..07767024 100644 --- a/lib/ppx/Form_ActionType.re +++ b/lib/ppx/Form_ActionType.re @@ -1,6 +1,7 @@ open Meta; open Ast; open AstHelpers; +open Printer; open Ppxlib; open Ast_helper; @@ -8,22 +9,61 @@ open Ast_helper; let ast = (~loc, scheme: Scheme.t) => { let update_actions = scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name}) => - Field.Field(name) - |> Field.update_action - |> T.constructor(~args=[[%type: input]], ~loc) - } + |> List.fold_left( + (acc, entry: Scheme.entry) => + switch (entry) { + | Field(field) => [ + FieldPrinter.update_action(~field=field.name) + |> T.constructor(~args=[[%type: input]], ~loc), + ...acc, + ] + | Collection({collection, fields}) => + fields + |> List.fold_left( + (acc, field: Scheme.field) => + [ + FieldOfCollectionPrinter.update_action( + ~collection, + ~field=field.name, + ) + |> T.constructor( + ~args=[[%type: input], [%type: index]], + ~loc, + ), + ...acc, + ], + acc, + ) + }, + [], ); let blur_actions = scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name}) => - Field.Field(name) |> Field.blur_action |> T.constructor(~loc) - } + |> List.fold_left( + (acc, entry: Scheme.entry) => + switch (entry) { + | Field(field) => [ + FieldPrinter.blur_action(~field=field.name) + |> T.constructor(~loc), + ...acc, + ] + | Collection({collection, fields}) => + List.fold_right( + (field: Scheme.field, acc) => + [ + FieldOfCollectionPrinter.blur_action( + ~collection, + ~field=field.name, + ) + |> T.constructor(~args=[[%type: index]], ~loc), + ...acc, + ], + fields, + acc, + ) + }, + [], ); let apply_async_result_actions = @@ -32,16 +72,15 @@ let ast = (~loc, scheme: Scheme.t) => { (acc, entry: Scheme.entry) => switch (entry) { | Field({validator: SyncValidator(_)}) => acc - | Field({name, validator: AsyncValidator(_), output_type}) => [ - Field.Field(name) - |> Field.apply_async_result_action + | Field({validator: AsyncValidator(_)} as field) => [ + FieldPrinter.apply_async_result_action(~field=field.name) |> T.constructor( ~args=[ - output_type |> FieldType.unpack, + field.output_type |> ItemType.unpack, Typ.constr( Lident("result") |> lid(~loc), [ - output_type |> FieldType.unpack, + field.output_type |> ItemType.unpack, Typ.constr(Lident("message") |> lid(~loc), []), ], ), @@ -50,6 +89,58 @@ let ast = (~loc, scheme: Scheme.t) => { ), ...acc, ] + | Collection({collection, fields}) => + fields + |> List.fold_left( + (acc, field: Scheme.field) => + switch (field) { + | {validator: SyncValidator(_)} => acc + | {validator: AsyncValidator(_)} as field => [ + FieldOfCollectionPrinter.apply_async_result_action( + ~collection, + ~field=field.name, + ) + |> T.constructor( + ~args=[ + field.output_type |> ItemType.unpack, + [%type: index], + Typ.constr( + Lident("result") |> lid(~loc), + [ + field.output_type |> ItemType.unpack, + Typ.constr( + Lident("message") |> lid(~loc), + [], + ), + ], + ), + ], + ~loc, + ), + ...acc, + ] + }, + acc, + ) + }, + [], + ); + + let collections_actions = + scheme + |> List.fold_left( + (acc, entry: Scheme.entry) => + switch (entry) { + | Field(_) => acc + | Collection({collection, input_type}) => [ + collection + |> CollectionPrinter.add_action + |> T.constructor(~args=[input_type |> ItemType.unpack], ~loc), + collection + |> CollectionPrinter.remove_action + |> T.constructor(~args=[[%type: index]], ~loc), + ...acc, + ] }, [], ); @@ -70,16 +161,22 @@ let ast = (~loc, scheme: Scheme.t) => { "Reset" |> T.constructor(~loc), ]; - "action" - |> str(~loc) - |> Type.mk( - ~kind= - Ptype_variant( - rest_actions - |> List.append(apply_async_result_actions) - |> List.append(blur_actions) - |> List.append(update_actions), + Str.type_( + ~loc, + Recursive, + [ + "action" + |> str(~loc) + |> Type.mk( + ~kind= + Ptype_variant( + rest_actions + |> List.append(collections_actions) + |> List.append(apply_async_result_actions) + |> List.append(blur_actions) + |> List.append(update_actions), + ), ), - ) - |> StructureItem.from_type_declaration(~loc, ~rec_flag=Recursive); + ], + ); }; diff --git a/lib/ppx/Form_CollectionsStatusesType.re b/lib/ppx/Form_CollectionsStatusesType.re new file mode 100644 index 00000000..24bdfce0 --- /dev/null +++ b/lib/ppx/Form_CollectionsStatusesType.re @@ -0,0 +1,34 @@ +open Meta; +open Ast; +open AstHelpers; +open Printer; + +open Ppxlib; +open Ast_helper; + +let ast = (~loc, collections: list(Collection.t)) => { + switch (collections) { + | [] => [%stri type collectionsStatuses = unit] + | _ => + Str.type_( + ~loc, + Recursive, + [ + "collectionsStatuses" + |> str(~loc) + |> Type.mk( + ~kind= + Ptype_record( + collections + |> List.map((collection: Collection.t) => + Type.field( + collection.plural |> str(~loc), + [%type: option(collectionStatus(message))], + ) + ), + ), + ), + ], + ) + }; +}; diff --git a/lib/ppx/Form_FieldsStatusesType.re b/lib/ppx/Form_FieldsStatusesType.re index 296135f3..d7635078 100644 --- a/lib/ppx/Form_FieldsStatusesType.re +++ b/lib/ppx/Form_FieldsStatusesType.re @@ -1,21 +1,77 @@ open Meta; open Ast; open AstHelpers; +open Printer; open Ppxlib; open Ast_helper; +let field_type = (~loc, field: Scheme.field) => + Type.field( + field.name |> str(~loc), + switch (field.validator) { + | SyncValidator(_) => [%type: + fieldStatus([%t field.output_type |> ItemType.unpack], message) + ] + | AsyncValidator(_) => [%type: + Async.fieldStatus([%t field.output_type |> ItemType.unpack], message) + ] + }, + ); + +let collection_type = (~loc, collection: Collection.t) => + Type.field( + collection.plural |> str(~loc), + [%type: + array( + [%t + Typ.constr( + Lident(collection |> CollectionPrinter.fields_statuses_type) + |> lid(~loc), + [], + ) + ], + ) + ], + ); + let ast = (~loc, scheme: Scheme.t) => { - scheme - |> T.record_of_fields( - ~name="fieldsStatuses", ~loc, ~typ=(~validator, ~output_type) => - switch (validator) { - | SyncValidator(_) => [%type: - fieldStatus([%t output_type |> FieldType.unpack], message) - ] - | AsyncValidator(_) => [%type: - Async.fieldStatus([%t output_type |> FieldType.unpack], message) - ] - } - ); + let main_decl = + "fieldsStatuses" + |> str(~loc) + |> Type.mk( + ~kind= + Ptype_record( + scheme + |> List.map((entry: Scheme.entry) => + switch (entry) { + | Field(field) => field |> field_type(~loc) + | Collection({collection}) => + collection |> collection_type(~loc) + } + ), + ), + ); + + let collections_decls = + scheme + |> List.fold_left( + (acc, entry: Scheme.entry) => + switch (entry) { + | Field(_) => acc + | Collection({collection, fields}) => [ + collection + |> CollectionPrinter.fields_statuses_type + |> str(~loc) + |> Type.mk( + ~kind= + Ptype_record(fields |> List.map(field_type(~loc))), + ), + ...acc, + ] + }, + [], + ); + + Str.type_(~loc, Recursive, [main_decl, ...collections_decls]); }; diff --git a/lib/ppx/Form_InitialCollectionsStatuses.re b/lib/ppx/Form_InitialCollectionsStatuses.re new file mode 100644 index 00000000..be493b9e --- /dev/null +++ b/lib/ppx/Form_InitialCollectionsStatuses.re @@ -0,0 +1,26 @@ +open Meta; +open Ast; +open AstHelpers; +open Printer; + +open Ppxlib; +open Ast_helper; + +let ast = (~loc, collections: list(Collection.t)) => { + [%stri + let initialCollectionsStatuses = + switch%e (collections) { + | [] => + %expr + () + | _ => + Exp.record( + collections + |> List.map((collection: Collection.t) => + (Lident(collection.plural) |> lid(~loc), [%expr None]) + ), + None, + ) + } + ]; +}; diff --git a/lib/ppx/Form_InitialFieldsStatusesFn.re b/lib/ppx/Form_InitialFieldsStatusesFn.re index 4d56fa65..aca54040 100644 --- a/lib/ppx/Form_InitialFieldsStatusesFn.re +++ b/lib/ppx/Form_InitialFieldsStatusesFn.re @@ -1,22 +1,55 @@ open Meta; open Ast; open AstHelpers; +open Printer; open Ppxlib; open Ast_helper; let ast = (~loc, scheme: Scheme.t) => { [%stri - let initialFieldsStatuses = (_input: input): fieldsStatuses => [%e + let initialFieldsStatuses = (input: input): fieldsStatuses => [%e Exp.record( scheme |> List.map((entry: Scheme.entry) => - ( - switch (entry) { - | Field({name}) => Lident(name) |> lid(~loc) - }, - [%expr Pristine], - ) + switch (entry) { + | Field(field) => ( + Lident(field.name) |> lid(~loc), + [%expr Pristine], + ) + | Collection({collection, fields}) => ( + Lident(collection.plural) |> lid(~loc), + [%expr + Belt.Array.make( + Belt.Array.length( + [%e collection.plural |> E.field(~of_="input", ~loc)], + ), + [%e + Exp.constraint_( + Exp.record( + fields + |> List.map((field: Scheme.field) => + ( + Lident(field.name) |> lid(~loc), + [%expr Pristine], + ) + ), + None, + ), + Typ.constr( + Lident( + collection + |> CollectionPrinter.fields_statuses_type, + ) + |> lid(~loc), + [], + ), + ) + ], + ) + ], + ) + } ), None, ) diff --git a/lib/ppx/Form_InitialStateFn.re b/lib/ppx/Form_InitialStateFn.re index 6dca133b..a1ab6182 100644 --- a/lib/ppx/Form_InitialStateFn.re +++ b/lib/ppx/Form_InitialStateFn.re @@ -9,6 +9,7 @@ let ast = (~loc) => [%stri let initialState = input => { input, fieldsStatuses: input->initialFieldsStatuses, + collectionsStatuses: initialCollectionsStatuses, formStatus: Editing, submissionStatus: NeverSubmitted, } diff --git a/lib/ppx/Form_InterfaceType.re b/lib/ppx/Form_InterfaceType.re index 91c97fcf..7744c2a2 100644 --- a/lib/ppx/Form_InterfaceType.re +++ b/lib/ppx/Form_InterfaceType.re @@ -1,6 +1,7 @@ open Meta; open Ast; open AstHelpers; +open Printer; open Ppxlib; open Ast_helper; @@ -29,60 +30,179 @@ let ast = (~loc, ~async: bool, scheme: Scheme.t) => { let update_fns = scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name}) => - f(Field.(Field(name) |> update_fn), [%type: input => unit]) - } + |> List.fold_left( + (acc, entry: Scheme.entry) => + switch (entry) { + | Field(field) => [ + f( + FieldPrinter.update_fn(~field=field.name), + [%type: input => unit], + ), + ...acc, + ] + | Collection({collection, fields}) => + fields + |> List.fold_left( + (acc, field: Scheme.field) => + [ + f( + FieldOfCollectionPrinter.update_fn( + ~collection, + ~field=field.name, + ), + [%type: (input, ~at: index) => unit], + ), + ...acc, + ], + acc, + ) + }, + [], ); let blur_fns = scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name}) => - f(Field.(Field(name) |> blur_fn), [%type: unit => unit]) - } + |> List.fold_left( + (acc, entry: Scheme.entry) => + switch (entry) { + | Field(field) => [ + f( + FieldPrinter.blur_fn(~field=field.name), + [%type: unit => unit], + ), + ...acc, + ] + | Collection({collection, fields}) => + fields + |> List.fold_left( + (acc, field: Scheme.field) => + [ + f( + FieldOfCollectionPrinter.blur_fn( + ~collection, + ~field=field.name, + ), + [%type: (~at: index) => unit], + ), + ...acc, + ], + acc, + ) + }, + [], ); let result_fns = scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name, validator, output_type}) => - f( - Field.(Field(name) |> result_fn), - switch (validator) { - | SyncValidator(_) => [%type: - unit => - option( - result([%t output_type |> FieldType.unpack], message), - ) - ] - | AsyncValidator(_) => [%type: - unit => - option( - Async.exposedFieldStatus( - [%t output_type |> FieldType.unpack], - message, - ), - ) - ] - }, - ) - } + |> List.fold_left( + (acc, entry: Scheme.entry) => + switch (entry) { + | Field(field) => [ + f( + FieldPrinter.result_fn(~field=field.name), + switch (field.validator) { + | SyncValidator(_) => [%type: + unit => + option( + result( + [%t field.output_type |> ItemType.unpack], + message, + ), + ) + ] + | AsyncValidator(_) => [%type: + unit => + option( + Async.exposedFieldStatus( + [%t field.output_type |> ItemType.unpack], + message, + ), + ) + ] + }, + ), + ...acc, + ] + | Collection({collection, fields}) => + fields + |> List.fold_left( + (acc, field: Scheme.field) => + [ + f( + FieldOfCollectionPrinter.result_fn( + ~collection, + ~field=field.name, + ), + switch (field.validator) { + | SyncValidator(_) => [%type: + (~at: index) => + option( + result( + [%t field.output_type |> ItemType.unpack], + message, + ), + ) + ] + | AsyncValidator(_) => [%type: + (~at: index) => + option( + Async.exposedFieldStatus( + [%t field.output_type |> ItemType.unpack], + message, + ), + ) + ] + }, + ), + ...acc, + ], + acc, + ) + }, + [], ); - "interface" - |> str(~loc) - |> Type.mk( - ~kind= - Ptype_record( - base - |> List.append(result_fns) - |> List.append(blur_fns) - |> List.append(update_fns), + let collection_entries = + scheme + |> List.fold_left( + (acc, entry: Scheme.entry) => + switch (entry) { + | Field(_) => acc + | Collection({collection, input_type}) => [ + f( + collection |> CollectionPrinter.add_fn, + [%type: [%t input_type |> ItemType.unpack] => unit], + ), + f( + collection |> CollectionPrinter.remove_fn, + [%type: (~at: index) => unit], + ), + f( + collection |> CollectionPrinter.result_value, + [%type: option(collectionStatus(message))], + ), + ...acc, + ] + }, + [], + ); + + Str.type_( + ~loc, + Recursive, + [ + "interface" + |> str(~loc) + |> Type.mk( + ~kind= + Ptype_record( + base + |> List.append(collection_entries) + |> List.append(result_fns) + |> List.append(blur_fns) + |> List.append(update_fns), + ), ), - ) - |> StructureItem.from_type_declaration(~loc, ~rec_flag=Recursive); + ], + ); }; diff --git a/lib/ppx/Form_StateType.re b/lib/ppx/Form_StateType.re index f438157d..53f6e474 100644 --- a/lib/ppx/Form_StateType.re +++ b/lib/ppx/Form_StateType.re @@ -9,6 +9,7 @@ let ast = (~loc) => [%stri type state = { input, fieldsStatuses, + collectionsStatuses, formStatus: formStatus(submissionError), submissionStatus, } diff --git a/lib/ppx/Form_UseFormFn.re b/lib/ppx/Form_UseFormFn.re index 0ce112b7..49ffa3fe 100644 --- a/lib/ppx/Form_UseFormFn.re +++ b/lib/ppx/Form_UseFormFn.re @@ -5,7 +5,8 @@ open AstHelpers; open Ppxlib; open Ast_helper; -let ast = (~loc, ~async: bool, scheme: Scheme.t) => [%stri +let ast = + (~loc, ~async: bool, ~collections: list(Collection.t), scheme: Scheme.t) => [%stri let useForm = ( ~initialInput: input, @@ -22,6 +23,13 @@ let ast = (~loc, ~async: bool, scheme: Scheme.t) => [%stri Exp.match( [%expr action], Form_UseFormFn_RestActions.ast(~loc, ~async) + |> List.append( + Form_UseFormFn_CollectionsActions.ast( + ~loc, + ~collections, + scheme, + ), + ) |> List.append( Form_UseFormFn_ApplyAsyncResultActions.ast(~loc, scheme), ) diff --git a/lib/ppx/Form_UseFormFn_ApplyAsyncResultActions.re b/lib/ppx/Form_UseFormFn_ApplyAsyncResultActions.re index 26099628..5707760b 100644 --- a/lib/ppx/Form_UseFormFn_ApplyAsyncResultActions.re +++ b/lib/ppx/Form_UseFormFn_ApplyAsyncResultActions.re @@ -1,6 +1,7 @@ open Meta; open Ast; open AstHelpers; +open Printer; open Ppxlib; open Ast_helper; @@ -11,12 +12,12 @@ let ast = (~loc, scheme: Scheme.t) => (acc, entry: Scheme.entry) => switch (entry) { | Field({validator: SyncValidator(_)}) => acc - | Field({name, validator}) => - let field = Field.Field(name); - [ + | Field({validator: AsyncValidator(_)} as field) => [ Exp.case( Pat.construct( - Lident(field |> Field.apply_async_result_action) + Lident( + FieldPrinter.apply_async_result_action(~field=field.name), + ) |> lid(~loc), Some( Pat.tuple([ @@ -29,11 +30,11 @@ let ast = (~loc, scheme: Scheme.t) => %expr { let validator = [%e - field |> E.field(~of_="validators", ~loc) + field.name |> E.field(~of_="validators", ~loc) ]; switch ( [%e - field + field.name |> E.field2(~of_=("state", "fieldsStatuses"), ~loc) ] ) { @@ -41,7 +42,7 @@ let ast = (~loc, scheme: Scheme.t) => Update({ ...state, fieldsStatuses: [%e - field + field.name |> E.update_field2( ~of_=("state", "fieldsStatuses"), ~with_=[%expr Dirty(result, Shown)], @@ -57,7 +58,77 @@ let ast = (~loc, scheme: Scheme.t) => }, ), ...acc, - ]; + ] + | Collection({collection, fields}) => + fields + |> List.fold_left( + (acc, field: Scheme.field) => + switch (field.validator) { + | SyncValidator(_) => acc + | AsyncValidator(_) => [ + Exp.case( + Pat.construct( + Lident( + FieldOfCollectionPrinter.apply_async_result_action( + ~collection, + ~field=field.name, + ), + ) + |> lid(~loc), + Some( + Pat.tuple([ + Pat.var("value" |> str(~loc)), + Pat.var("index" |> str(~loc)), + Pat.var("result" |> str(~loc)), + ]), + ), + ), + { + %expr + { + let validator = [%e + field.name + |> E.field_of_collection_validator( + ~validators="validators", + ~collection, + ~loc, + ) + ]; + switch ( + [%e + field.name + |> E.field_in_collection2( + ~of_=("state", "fieldsStatuses"), + ~collection, + ~loc, + ) + ] + ) { + | Validating(x) when validator.eq(x, value) => + Update({ + ...state, + fieldsStatuses: [%e + field.name + |> E.update_field_in_collection2( + ~of_=("state", "fieldsStatuses"), + ~collection, + ~with_=[%expr Dirty(result, Shown)], + ~loc, + ) + ], + }) + | Validating(_) + | Pristine + | Dirty(_, Shown | Hidden) => NoUpdate + }; + }; + }, + ), + ...acc, + ] + }, + acc, + ) }, [], ); diff --git a/lib/ppx/Form_UseFormFn_BlurActions.re b/lib/ppx/Form_UseFormFn_BlurActions.re index faad7bfd..4f0231f4 100644 --- a/lib/ppx/Form_UseFormFn_BlurActions.re +++ b/lib/ppx/Form_UseFormFn_BlurActions.re @@ -1,56 +1,141 @@ open Meta; open Ast; open AstHelpers; +open Printer; open Ppxlib; open Ast_helper; let ast = (~loc, scheme: Scheme.t) => scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name, validator}) => - let field = Field.Field(name); - Exp.case( - Pat.construct( - Lident(field |> Field.blur_action) |> lid(~loc), - None, - ), - { - let field_status_expr = - field |> E.field2(~of_=("state", "fieldsStatuses"), ~loc); - let field_input_expr = - field |> E.field2(~of_=("state", "input"), ~loc); - let validator_expr = field |> E.field(~of_="validators", ~loc); - let set_status_expr = - field - |> E.update_field2( - ~of_=("state", "fieldsStatuses"), - ~with_=[%expr status], - ~loc, - ); + |> List.fold_left( + (acc, entry: Scheme.entry) => + switch (entry) { + | Field(field) => [ + Exp.case( + Pat.construct( + Lident(FieldPrinter.blur_action(~field=field.name)) + |> lid(~loc), + None, + ), + { + let field_status_expr = + field.name + |> E.field2(~of_=("state", "fieldsStatuses"), ~loc); + let field_input_expr = + field.name |> E.field2(~of_=("state", "input"), ~loc); + let validator_expr = + field.name |> E.field(~of_="validators", ~loc); + let set_status_expr = + field.name + |> E.update_field2( + ~of_=("state", "fieldsStatuses"), + ~with_=[%expr status], + ~loc, + ); - switch (validator) { - | SyncValidator(validator) => - Form_UseFormFn_BlurActions_Sync.ast( - ~loc, - ~validator, - ~field_status_expr, - ~field_input_expr, - ~validator_expr, - ~set_status_expr, - ) - | AsyncValidator({optionality}) => - Form_UseFormFn_BlurActions_Async.ast( - ~loc, - ~field, - ~optionality, - ~field_status_expr, - ~validator_expr, - ~set_status_expr, - ) - }; - }, - ); - } + switch (field.validator) { + | SyncValidator(validator) => + Form_UseFormFn_BlurActions_SyncField.ast( + ~loc, + ~kind=`Field, + ~validator, + ~field_status_expr, + ~field_input_expr, + ~validator_expr, + ~set_status_expr, + ) + | AsyncValidator({optionality}) => + Form_UseFormFn_BlurActions_AsyncField.ast( + ~loc, + ~field, + ~kind=`Field, + ~optionality, + ~field_status_expr, + ~validator_expr, + ~set_status_expr, + ) + }; + }, + ), + ...acc, + ] + | Collection({collection, fields}) => + fields + |> List.fold_left( + (acc, field: Scheme.field) => + [ + Exp.case( + Pat.construct( + ~attrs=[explicit_arity(~loc)], + Lident( + FieldOfCollectionPrinter.blur_action( + ~collection, + ~field=field.name, + ), + ) + |> lid(~loc), + Some(Pat.tuple([Pat.var("index" |> str(~loc))])), + ), + { + let field_status_expr = + field.name + |> E.field_in_collection2( + ~of_=("state", "fieldsStatuses"), + ~collection, + ~loc, + ); + let field_input_expr = + field.name + |> E.field_in_collection2( + ~of_=("state", "input"), + ~collection, + ~loc, + ); + let validator_expr = + field.name + |> E.field_of_collection_validator( + ~validators="validators", + ~collection, + ~loc, + ); + let set_status_expr = + field.name + |> E.update_field_in_collection2( + ~of_=("state", "fieldsStatuses"), + ~collection, + ~with_=[%expr status], + ~loc, + ); + + switch (field.validator) { + | SyncValidator(validator) => + Form_UseFormFn_BlurActions_SyncField.ast( + ~loc, + ~kind=`FieldOfCollection, + ~validator, + ~field_status_expr, + ~field_input_expr, + ~validator_expr, + ~set_status_expr, + ) + | AsyncValidator({optionality}) => + Form_UseFormFn_BlurActions_AsyncField.ast( + ~loc, + ~field, + ~kind=`FieldOfCollection, + ~optionality, + ~field_status_expr, + ~validator_expr, + ~set_status_expr, + ) + }; + }, + ), + ...acc, + ], + acc, + ) + }, + [], ); diff --git a/lib/ppx/Form_UseFormFn_BlurActions_Async.re b/lib/ppx/Form_UseFormFn_BlurActions_Async.re deleted file mode 100644 index 80aa09de..00000000 --- a/lib/ppx/Form_UseFormFn_BlurActions_Async.re +++ /dev/null @@ -1,80 +0,0 @@ -open Meta; -open Ast; -open AstHelpers; - -open Ppxlib; -open Ast_helper; - -let ast = - ( - ~loc, - ~field: Field.t, - ~optionality: option(FieldOptionality.t), - ~field_status_expr: expression, - ~validator_expr: expression, - ~set_status_expr: expression, - ) => { - %expr - { - let result = - switch%e (optionality) { - | None => - %expr - { - Async.validateFieldOnBlur( - ~input=state.input, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | Some(OptionType) => - %expr - { - Async.validateFieldOfOptionTypeOnBlur( - ~input=state.input, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | Some(StringType) => - %expr - { - Async.validateFieldOfStringTypeOnBlur( - ~input=state.input, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | Some(OptionStringType) => - %expr - { - Async.validateFieldOfOptionStringTypeOnBlur( - ~input=state.input, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - }; - - switch (result) { - | None => NoUpdate - | Some(fieldsStatuses) => - switch ([%e field |> E.field(~of_="fieldsStatuses", ~loc)]) { - | Validating(value) => - UpdateWithSideEffects( - {...state, fieldsStatuses}, - ({dispatch}) => { - let validator = [%e field |> E.field(~of_="validators", ~loc)]; - validator.validateAsync((value, dispatch)); - }, - ) - | Pristine - | Dirty(_, Shown | Hidden) => Update({...state, fieldsStatuses}) - } - }; - }; -}; diff --git a/lib/ppx/Form_UseFormFn_BlurActions_AsyncField.re b/lib/ppx/Form_UseFormFn_BlurActions_AsyncField.re new file mode 100644 index 00000000..297e10d5 --- /dev/null +++ b/lib/ppx/Form_UseFormFn_BlurActions_AsyncField.re @@ -0,0 +1,139 @@ +open Meta; +open Ast; +open AstHelpers; + +open Ppxlib; +open Ast_helper; + +let ast = + ( + ~loc, + ~field: Scheme.field, + ~kind: [ | `Field | `FieldOfCollection], + ~optionality: option(FieldOptionality.t), + ~field_status_expr: expression, + ~validator_expr: expression, + ~set_status_expr: expression, + ) => { + %expr + { + let result = + switch%e (optionality) { + | None => + switch (kind) { + | `Field => + %expr + { + Async.validateFieldOnBlur( + ~input=state.input, + ~fieldStatus=[%e field_status_expr], + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + | `FieldOfCollection => + %expr + { + Async.validateFieldOfCollectionOnBlur( + ~input=state.input, + ~index, + ~fieldStatus=[%e field_status_expr], + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + } + | Some(OptionType) => + switch (kind) { + | `Field => + %expr + { + Async.validateFieldOfOptionTypeOnBlur( + ~input=state.input, + ~fieldStatus=[%e field_status_expr], + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + | `FieldOfCollection => + %expr + { + Async.validateFieldOfCollectionOfOptionTypeOnBlur( + ~input=state.input, + ~index, + ~fieldStatus=[%e field_status_expr], + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + } + | Some(StringType) => + switch (kind) { + | `Field => + %expr + { + Async.validateFieldOfStringTypeOnBlur( + ~input=state.input, + ~fieldStatus=[%e field_status_expr], + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + | `FieldOfCollection => + %expr + { + Async.validateFieldOfCollectionOfStringTypeOnBlur( + ~input=state.input, + ~index, + ~fieldStatus=[%e field_status_expr], + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + } + | Some(OptionStringType) => + switch (kind) { + | `Field => + %expr + { + Async.validateFieldOfOptionStringTypeOnBlur( + ~input=state.input, + ~fieldStatus=[%e field_status_expr], + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + | `FieldOfCollection => + %expr + { + Async.validateFieldOfCollectionOfOptionStringTypeOnBlur( + ~input=state.input, + ~index, + ~fieldStatus=[%e field_status_expr], + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + } + }; + + switch (result) { + | None => NoUpdate + | Some(fieldsStatuses) => + switch ([%e field.name |> E.field(~of_="fieldsStatuses", ~loc)]) { + | Validating(value) => + UpdateWithSideEffects( + {...state, fieldsStatuses}, + ({dispatch}) => { + let validator = [%e + field.name |> E.field(~of_="validators", ~loc) + ]; + validator.validateAsync((value, dispatch)); + }, + ) + | Pristine + | Dirty(_, Shown | Hidden) => Update({...state, fieldsStatuses}) + } + }; + }; +}; diff --git a/lib/ppx/Form_UseFormFn_BlurActions_Sync.re b/lib/ppx/Form_UseFormFn_BlurActions_SyncField.re similarity index 54% rename from lib/ppx/Form_UseFormFn_BlurActions_Sync.re rename to lib/ppx/Form_UseFormFn_BlurActions_SyncField.re index 9b02fe5a..35ad46df 100644 --- a/lib/ppx/Form_UseFormFn_BlurActions_Sync.re +++ b/lib/ppx/Form_UseFormFn_BlurActions_SyncField.re @@ -8,6 +8,7 @@ open Ast_helper; let ast = ( ~loc, + ~kind: [ | `Field | `FieldOfCollection], ~validator: result(FieldValidator.sync, unit), ~field_status_expr: expression, ~field_input_expr: expression, @@ -20,13 +21,25 @@ let ast = switch%e (validator) { | Ok(Required | Optional(Some(_))) | Error () => - %expr - validateFieldOnBlurWithValidator( - ~input=state.input, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) + switch (kind) { + | `Field => + %expr + validateFieldOnBlurWithValidator( + ~input=state.input, + ~fieldStatus=[%e field_status_expr], + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ) + | `FieldOfCollection => + %expr + validateFieldOfCollectionOnBlurWithValidator( + ~input=state.input, + ~index, + ~fieldStatus=[%e field_status_expr], + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ) + } | Ok(Optional(None)) => %expr validateFieldOnBlurWithoutValidator( diff --git a/lib/ppx/Form_UseFormFn_CollectionsActions.re b/lib/ppx/Form_UseFormFn_CollectionsActions.re new file mode 100644 index 00000000..37269563 --- /dev/null +++ b/lib/ppx/Form_UseFormFn_CollectionsActions.re @@ -0,0 +1,204 @@ +open Meta; +open Ast; +open AstHelpers; +open Printer; + +open Ppxlib; +open Ast_helper; + +let ast = (~loc, ~collections: list(Collection.t), scheme: Scheme.t) => + scheme + |> List.fold_left( + (acc, entry: Scheme.entry) => + switch (entry) { + | Field(_) => acc + | Collection({collection, validator, fields}) => + let add_action_pat = + Pat.construct( + ~attrs=[explicit_arity(~loc)], + Lident(collection |> CollectionPrinter.add_action) + |> lid(~loc), + Some(Pat.tuple([Pat.var("entry" |> str(~loc))])), + ); + + let add_entry_to_input_exp = + collection.plural + |> E.update_field2( + ~of_=("state", "input"), + ~with_=[%expr + Belt.Array.concat( + [%e + collection.plural + |> E.field2(~of_=("state", "input"), ~loc) + ], + [|entry|], + ) + ], + ~loc, + ); + + let add_entry_to_fields_statuses_exp = + collection.plural + |> E.update_field2( + ~of_=("state", "fieldsStatuses"), + ~with_=[%expr + Belt.Array.concat( + [%e + collection.plural + |> E.field2(~of_=("state", "fieldsStatuses"), ~loc) + ], + [| + [%e + Exp.record( + fields + |> List.map((field: Scheme.field) => + ( + Lident(field.name) |> lid(~loc), + [%expr Pristine], + ) + ), + None, + ) + ], + |], + ) + ], + ~loc, + ); + + let remove_action_pat = + Pat.construct( + ~attrs=[explicit_arity(~loc)], + Lident(collection |> CollectionPrinter.remove_action) + |> lid(~loc), + Some(Pat.tuple([Pat.var("index" |> str(~loc))])), + ); + + let remove_entry_from_input_exp = + collection.plural + |> E.update_field2( + ~of_=("state", "input"), + ~with_=[%expr + Belt.Array.keepWithIndex( + [%e + collection.plural + |> E.field2(~of_=("state", "input"), ~loc) + ], + (_, i) => + i != index + ) + ], + ~loc, + ); + + let remove_entry_from_fields_statuses_exp = + collection.plural + |> E.update_field2( + ~of_=("state", "fieldsStatuses"), + ~with_=[%expr + Belt.Array.keepWithIndex( + [%e + collection.plural + |> E.field2(~of_=("state", "fieldsStatuses"), ~loc) + ], + (_, i) => + i != index + ) + ], + ~loc, + ); + + let update_collections_statuses = + Exp.record( + [ + ( + Lident(collection.plural) |> lid(~loc), + [%expr + Some( + [%e + Exp.apply( + E.field2( + ~of_=("validators", collection.plural), + ~loc, + "collection", + ), + [(Nolabel, [%expr nextInput])], + ) + ], + ) + ], + ), + ], + switch (collections) { + | [] => None + | [x] => None + | _ => Some([%expr state.collectionsStatuses]) + }, + ); + + [ + Exp.case( + add_action_pat, + { + %expr + { + let nextInput = [%e add_entry_to_input_exp]; + let nextFieldsStatuses = [%e + add_entry_to_fields_statuses_exp + ]; + switch%e (validator) { + | Ok(Some ()) + | Error () => + %expr + Update({ + ...state, + input: nextInput, + fieldsStatuses: nextFieldsStatuses, + collectionsStatuses: [%e update_collections_statuses], + }) + | Ok(None) => + %expr + Update({ + ...state, + input: nextInput, + fieldsStatuses: nextFieldsStatuses, + }) + }; + }; + }, + ), + Exp.case( + remove_action_pat, + { + %expr + { + let nextInput = [%e remove_entry_from_input_exp]; + let nextFieldsStatuses = [%e + remove_entry_from_fields_statuses_exp + ]; + switch%e (validator) { + | Ok(Some ()) + | Error () => + %expr + Update({ + ...state, + input: nextInput, + fieldsStatuses: nextFieldsStatuses, + collectionsStatuses: [%e update_collections_statuses], + }) + | Ok(None) => + %expr + Update({ + ...state, + input: nextInput, + fieldsStatuses: nextFieldsStatuses, + }) + }; + }; + }, + ), + ...acc, + ]; + }, + [], + ); diff --git a/lib/ppx/Form_UseFormFn_Interface.re b/lib/ppx/Form_UseFormFn_Interface.re index 5f5a3e0c..e10b2333 100644 --- a/lib/ppx/Form_UseFormFn_Interface.re +++ b/lib/ppx/Form_UseFormFn_Interface.re @@ -1,10 +1,35 @@ open Meta; open Ast; open AstHelpers; +open Printer; open Ppxlib; open Ast_helper; +let dirty_collection_guard = + (~loc, (collection: Collection.t, fields: list(Scheme.field))) => [%expr + Belt.Array.every( + [%e Exp.ident(Lident(collection.plural) |> lid(~loc))], item => { + %e + Exp.match( + [%expr item], + [ + Exp.case( + Pat.record( + fields + |> List.map((field: Scheme.field) => + (Lident(field.name) |> lid(~loc), [%pat? Pristine]) + ), + Closed, + ), + [%expr true], + ), + Exp.case([%pat? _], [%expr false]), + ], + ) + }) +]; + let ast = (~loc, ~async: bool, scheme: Scheme.t) => { let base = [ ("input", [%expr state.input]), @@ -20,15 +45,48 @@ let ast = (~loc, ~async: bool, scheme: Scheme.t) => { Pat.record( scheme |> List.map((entry: Scheme.entry) => - ( - switch (entry) { - | Field({name}) => Lident(name) |> lid(~loc) - }, - [%pat? Pristine], - ) + switch (entry) { + | Field(field) => ( + Lident(field.name) |> lid(~loc), + [%pat? Pristine], + ) + | Collection({collection}) => ( + Lident(collection.plural) |> lid(~loc), + Pat.var(collection.plural |> str(~loc)), + ) + } ), Closed, ), + ~guard=?{ + switch ( + scheme + |> List.fold_left( + (acc, entry: Scheme.entry) => + switch (entry) { + | Field(_) => acc + | Collection({collection, fields}) => [ + (collection, fields), + ...acc, + ] + }, + [], + ) + ) { + | [] => None + | [collection] => + Some(dirty_collection_guard(~loc, collection)) + | [collection, ...collections] => + Some( + collections + |> E.conj( + ~loc, + ~exp=dirty_collection_guard(~loc, collection), + ~make=dirty_collection_guard, + ), + ) + }; + }, [%expr false], ), Exp.case([%pat? _], [%expr true]), @@ -46,9 +104,9 @@ let ast = (~loc, ~async: bool, scheme: Scheme.t) => { state.input ->validateForm(~validators, ~fieldsStatuses=state.fieldsStatuses) ) { - | None => None - | Some(Valid(_)) => Some(true) - | Some(Invalid(_)) => Some(false) + | Validating(_) => None + | Valid(_) => Some(true) + | Invalid(_) => Some(false) }; } else { %expr @@ -86,89 +144,278 @@ let ast = (~loc, ~async: bool, scheme: Scheme.t) => { let update_fns = scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name}) => ( - Field.(Field(name) |> update_fn), - [%expr + |> List.fold_left( + (acc, entry: Scheme.entry) => + switch (entry) { + | Field(field) => [ ( - input => - [%e - Exp.construct( - Lident(Field.(Field(name) |> update_action)) - |> lid(~loc), - Some([%expr input]), - ) - ] - ->dispatch - ) - ], - ) - } + FieldPrinter.update_fn(~field=field.name), + [%expr + ( + input => + [%e + Exp.construct( + Lident( + FieldPrinter.update_action(~field=field.name), + ) + |> lid(~loc), + Some([%expr input]), + ) + ] + ->dispatch + ) + ], + ), + ...acc, + ] + | Collection({collection, fields}) => + fields + |> List.fold_left( + (acc, field: Scheme.field) => + [ + ( + FieldOfCollectionPrinter.update_fn( + ~collection, + ~field=field.name, + ), + [%expr + (input, ~at as index) => + [%e + Exp.construct( + Lident( + FieldOfCollectionPrinter.update_action( + ~collection, + ~field=field.name, + ), + ) + |> lid(~loc), + Some([%expr (input, index)]), + ) + ] + ->dispatch + ], + ), + ...acc, + ], + acc, + ) + }, + [], ); let blur_fns = scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name}) => ( - Field.(Field(name) |> blur_fn), - [%expr + |> List.fold_left( + (acc, entry: Scheme.entry) => + switch (entry) { + | Field(field) => [ ( - () => - [%e - Exp.construct( - Lident(Field.(Field(name) |> blur_action)) - |> lid(~loc), - None, - ) - ] - ->dispatch - ) - ], - ) - } + FieldPrinter.blur_fn(~field=field.name), + [%expr + ( + () => + [%e + Exp.construct( + Lident( + FieldPrinter.blur_action(~field=field.name), + ) + |> lid(~loc), + None, + ) + ] + ->dispatch + ) + ], + ), + ...acc, + ] + | Collection({collection, fields}) => + fields + |> List.fold_left( + (acc, field: Scheme.field) => + [ + ( + FieldOfCollectionPrinter.blur_fn( + ~collection, + ~field=field.name, + ), + [%expr + (~at as index) => + [%e + Exp.construct( + Lident( + FieldOfCollectionPrinter.blur_action( + ~collection, + ~field=field.name, + ), + ) + |> lid(~loc), + Some([%expr index]), + ) + ] + ->dispatch + ], + ), + ...acc, + ], + acc, + ) + }, + [], ); let result_fns = scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name, validator}) => ( - Field.(Field(name) |> result_fn), - switch (validator) { - | SyncValidator(_) => - %expr + |> List.fold_left( + (acc, entry: Scheme.entry) => + switch (entry) { + | Field(field) => [ + ( + FieldPrinter.result_fn(~field=field.name), + switch (field.validator) { + | SyncValidator(_) => + %expr + ( + () => { + exposeFieldResult( + [%e + field.name + |> E.field2( + ~of_=("state", "fieldsStatuses"), + ~loc, + ) + ], + ); + } + ) + | AsyncValidator(_) => + %expr + ( + () => { + Async.exposeFieldResult( + [%e + field.name + |> E.field2( + ~of_=("state", "fieldsStatuses"), + ~loc, + ) + ], + ); + } + ) + }, + ), + ...acc, + ] + | Collection({collection, fields}) => + fields + |> List.fold_left( + (acc, field: Scheme.field) => + [ + ( + FieldOfCollectionPrinter.result_fn( + ~collection, + ~field=field.name, + ), + switch (field.validator) { + | SyncValidator(_) => + %expr + ( + (~at as index) => { + exposeFieldResult( + [%e + field.name + |> E.field_in_collection2( + ~of_=("state", "fieldsStatuses"), + ~collection, + ~loc, + ) + ], + ); + } + ) + | AsyncValidator(_) => + %expr + ( + (~at as index) => { + Async.exposeFieldResult( + [%e + field.name + |> E.field_in_collection2( + ~of_=("state", "fieldsStatuses"), + ~collection, + ~loc, + ) + ], + ); + } + ) + }, + ), + ...acc, + ], + acc, + ) + }, + [], + ); + + let collection_entries = + scheme + |> List.fold_left( + (acc, entry: Scheme.entry) => + switch (entry) { + | Field(_) => acc + | Collection({collection}) => [ + ( + collection |> CollectionPrinter.add_fn, + [%expr + ( + entry => + [%e + Exp.construct( + Lident(collection |> CollectionPrinter.add_action) + |> lid(~loc), + Some([%expr entry]), + ) + ] + ->dispatch + ) + ], + ), ( - () => { - exposeFieldResult( - [%e - Field.Field(name) - |> E.field2(~of_=("state", "fieldsStatuses"), ~loc) - ], - ); - } - ) - | AsyncValidator(_) => - %expr + collection |> CollectionPrinter.remove_fn, + [%expr + ( + (~at as index) => + [%e + Exp.construct( + Lident( + collection |> CollectionPrinter.remove_action, + ) + |> lid(~loc), + Some([%expr index]), + ) + ] + ->dispatch + ) + ], + ), ( - () => { - Async.exposeFieldResult( - [%e - Field.Field(name) - |> E.field2(~of_=("state", "fieldsStatuses"), ~loc) - ], - ); - } - ) - }, - ) - } + collection |> CollectionPrinter.result_value, + collection.plural + |> E.field2(~of_=("state", "collectionsStatuses"), ~loc), + ), + ...acc, + ] + }, + [], ); E.record( ~loc, result_fns + |> List.append(collection_entries) |> List.append(blur_fns) |> List.append(update_fns) |> List.append(base), diff --git a/lib/ppx/Form_UseFormFn_RestActions.re b/lib/ppx/Form_UseFormFn_RestActions.re index 19e347b4..829866d2 100644 --- a/lib/ppx/Form_UseFormFn_RestActions.re +++ b/lib/ppx/Form_UseFormFn_RestActions.re @@ -18,8 +18,8 @@ let ast = (~loc, ~async) => [ state.input ->validateForm(~validators, ~fieldsStatuses=state.fieldsStatuses) ) { - | None => NoUpdate - | Some(Valid({output, fieldsStatuses})) => + | Validating({fieldsStatuses}) => Update({...state, fieldsStatuses}) + | Valid({output, fieldsStatuses}) => UpdateWithSideEffects( { ...state, @@ -45,7 +45,7 @@ let ast = (~loc, ~async) => [ DismissSubmissionResult->dispatch, }), ) - | Some(Invalid({fieldsStatuses})) => + | Invalid({fieldsStatuses}) => Update({ ...state, fieldsStatuses, diff --git a/lib/ppx/Form_UseFormFn_UpdateActions.re b/lib/ppx/Form_UseFormFn_UpdateActions.re index c039e432..a940b348 100644 --- a/lib/ppx/Form_UseFormFn_UpdateActions.re +++ b/lib/ppx/Form_UseFormFn_UpdateActions.re @@ -1,100 +1,46 @@ open Meta; open Ast; open AstHelpers; +open Printer; open Ppxlib; open Ast_helper; let ast = (~loc, scheme: Scheme.t) => scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name, deps, validator}) => - let field = Field.Field(name); - - Exp.case( - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident(field |> Field.update_action) |> lid(~loc), - Some(Pat.tuple([Pat.var("input" |> str(~loc))])), - ), - switch (deps) { - | [] => - let field_status_expr = - field |> E.field2(~of_=("state", "fieldsStatuses"), ~loc); - let field_input_expr = field |> E.field(~of_="input", ~loc); - let validator_expr = field |> E.field(~of_="validators", ~loc); - let set_status_expr = - field - |> E.update_field2( - ~of_=("state", "fieldsStatuses"), - ~with_=[%expr status], - ~loc, - ); - - switch (validator) { - | SyncValidator(validator) => - Form_UseFormFn_UpdateActions_Sync.ast( - ~loc, - ~validator, - ~field_status_expr, - ~field_input_expr, - ~validator_expr, - ~set_status_expr, - ) - | AsyncValidator({mode: OnBlur, optionality}) => - Form_UseFormFn_UpdateActions_AsyncOnBlurMode.ast( - ~loc, - ~optionality, - ~field_status_expr, - ~validator_expr, - ~set_status_expr, - ) - | AsyncValidator({mode: OnChange, optionality}) => - Form_UseFormFn_UpdateActions_AsyncOnChangeMode.ast( - ~loc, - ~field, - ~optionality, - ~field_status_expr, - ~validator_expr, - ~set_status_expr, - ) - }; - - | [dep, ...deps] => - %expr - { - let nextFieldsStatuses = ref(state.fieldsStatuses); - - %e - { - Form_UseFormFn_UpdateActions_Deps.ast( - ~loc, - ~dep, - ~deps, - ~scheme, - ); - }; - - %e - { + |> List.fold_left( + (acc, entry: Scheme.entry) => + switch (entry) { + | Field(field) => [ + Exp.case( + Pat.construct( + ~attrs=[explicit_arity(~loc)], + Lident(FieldPrinter.update_action(~field=field.name)) + |> lid(~loc), + Some(Pat.tuple([Pat.var("input" |> str(~loc))])), + ), + switch (field.deps) { + | [] => let field_status_expr = - field |> E.ref_field(~of_="nextFieldsStatuses", ~loc); - let field_input_expr = field |> E.field(~of_="input", ~loc); + field.name + |> E.field2(~of_=("state", "fieldsStatuses"), ~loc); + let field_input_expr = + field.name |> E.field(~of_="input", ~loc); let validator_expr = - field |> E.field(~of_="validators", ~loc); + field.name |> E.field(~of_="validators", ~loc); let set_status_expr = - field - |> E.update_ref_field( - ~of_="nextFieldsStatuses", + field.name + |> E.update_field2( + ~of_=("state", "fieldsStatuses"), ~with_=[%expr status], ~loc, ); - switch (validator) { + switch (field.validator) { | SyncValidator(validator) => - Form_UseFormFn_UpdateActions_Sync.ast( + Form_UseFormFn_UpdateActions_SyncField.ast( ~loc, + ~kind=`Field, ~validator, ~field_status_expr, ~field_input_expr, @@ -102,26 +48,270 @@ let ast = (~loc, scheme: Scheme.t) => ~set_status_expr, ) | AsyncValidator({mode: OnBlur, optionality}) => - Form_UseFormFn_UpdateActions_AsyncOnBlurMode.ast( + Form_UseFormFn_UpdateActions_AsyncFieldInOnBlurMode.ast( ~loc, + ~kind=`Field, ~optionality, ~field_status_expr, ~validator_expr, ~set_status_expr, ) | AsyncValidator({mode: OnChange, optionality}) => - Form_UseFormFn_UpdateActions_AsyncOnChangeMode.ast( + Form_UseFormFn_UpdateActions_AsyncFieldInOnChangeMode.ast( ~loc, ~field, + ~kind=`Field, ~optionality, ~field_status_expr, ~validator_expr, ~set_status_expr, ) }; - }; - } - }, - ); - } + + | [dep, ...deps] => + %expr + { + let nextFieldsStatuses = ref(state.fieldsStatuses); + + %e + { + Form_UseFormFn_UpdateActions_DependentFields.ast( + ~loc, + ~dep, + ~deps, + ~scheme, + ~field=`Field(field.name), + ); + }; + + %e + { + let field_status_expr = + field.name + |> E.ref_field(~of_="nextFieldsStatuses", ~loc); + let field_input_expr = + field.name |> E.field(~of_="input", ~loc); + let validator_expr = + field.name |> E.field(~of_="validators", ~loc); + let set_status_expr = + field.name + |> E.update_ref_field( + ~of_="nextFieldsStatuses", + ~with_=[%expr status], + ~loc, + ); + + switch (field.validator) { + | SyncValidator(validator) => + Form_UseFormFn_UpdateActions_SyncField.ast( + ~loc, + ~kind=`Field, + ~validator, + ~field_status_expr, + ~field_input_expr, + ~validator_expr, + ~set_status_expr, + ) + | AsyncValidator({mode: OnBlur, optionality}) => + Form_UseFormFn_UpdateActions_AsyncFieldInOnBlurMode.ast( + ~loc, + ~kind=`Field, + ~optionality, + ~field_status_expr, + ~validator_expr, + ~set_status_expr, + ) + | AsyncValidator({mode: OnChange, optionality}) => + Form_UseFormFn_UpdateActions_AsyncFieldInOnChangeMode.ast( + ~loc, + ~field, + ~kind=`Field, + ~optionality, + ~field_status_expr, + ~validator_expr, + ~set_status_expr, + ) + }; + }; + } + }, + ), + ...acc, + ] + | Collection({collection, fields}) => + fields + |> List.fold_left( + (acc, field: Scheme.field) => + [ + Exp.case( + Pat.construct( + ~attrs=[explicit_arity(~loc)], + Lident( + FieldOfCollectionPrinter.update_action( + ~collection, + ~field=field.name, + ), + ) + |> lid(~loc), + Some( + Pat.tuple([ + Pat.var("input" |> str(~loc)), + Pat.var("index" |> str(~loc)), + ]), + ), + ), + switch (field.deps) { + | [] => + let field_status_expr = + field.name + |> E.field_in_collection2( + ~of_=("state", "fieldsStatuses"), + ~collection, + ~loc, + ); + let field_input_expr = + field.name + |> E.field_in_collection( + ~of_="input", + ~collection, + ~loc, + ); + let validator_expr = + field.name + |> E.field_of_collection_validator( + ~validators="validators", + ~collection, + ~loc, + ); + let set_status_expr = + field.name + |> E.update_field_in_collection2( + ~of_=("state", "fieldsStatuses"), + ~collection, + ~with_=[%expr status], + ~loc, + ); + + switch (field.validator) { + | SyncValidator(validator) => + Form_UseFormFn_UpdateActions_SyncField.ast( + ~loc, + ~kind=`FieldOfCollection, + ~validator, + ~field_status_expr, + ~field_input_expr, + ~validator_expr, + ~set_status_expr, + ) + | AsyncValidator({mode: OnBlur, optionality}) => + Form_UseFormFn_UpdateActions_AsyncFieldInOnBlurMode.ast( + ~loc, + ~kind=`FieldOfCollection, + ~optionality, + ~field_status_expr, + ~validator_expr, + ~set_status_expr, + ) + | AsyncValidator({mode: OnChange, optionality}) => + Form_UseFormFn_UpdateActions_AsyncFieldInOnChangeMode.ast( + ~loc, + ~field, + ~kind=`FieldOfCollection, + ~optionality, + ~field_status_expr, + ~validator_expr, + ~set_status_expr, + ) + }; + + | [dep, ...deps] => + %expr + { + let nextFieldsStatuses = ref(state.fieldsStatuses); + + %e + { + Form_UseFormFn_UpdateActions_DependentFields.ast( + ~loc, + ~dep, + ~deps, + ~scheme, + ~field= + `FieldOfCollection((collection, field.name)), + ); + }; + + %e + { + let field_status_expr = + field.name + |> E.ref_field_in_collection( + ~of_="nextFieldsStatuses", + ~collection, + ~loc, + ); + let field_input_expr = + field.name + |> E.field_in_collection( + ~of_="input", + ~collection, + ~loc, + ); + let validator_expr = + field.name + |> E.field_of_collection_validator( + ~validators="validators", + ~collection, + ~loc, + ); + let set_status_expr = + field.name + |> E.update_ref_field_in_collection( + ~of_="nextFieldsStatuses", + ~collection, + ~with_=[%expr status], + ~loc, + ); + + switch (field.validator) { + | SyncValidator(validator) => + Form_UseFormFn_UpdateActions_SyncField.ast( + ~loc, + ~kind=`FieldOfCollection, + ~validator, + ~field_status_expr, + ~field_input_expr, + ~validator_expr, + ~set_status_expr, + ) + | AsyncValidator({mode: OnBlur, optionality}) => + Form_UseFormFn_UpdateActions_AsyncFieldInOnBlurMode.ast( + ~loc, + ~kind=`FieldOfCollection, + ~optionality, + ~field_status_expr, + ~validator_expr, + ~set_status_expr, + ) + | AsyncValidator({mode: OnChange, optionality}) => + Form_UseFormFn_UpdateActions_AsyncFieldInOnChangeMode.ast( + ~loc, + ~field, + ~kind=`FieldOfCollection, + ~optionality, + ~field_status_expr, + ~validator_expr, + ~set_status_expr, + ) + }; + }; + } + }, + ), + ...acc, + ], + acc, + ) + }, + [], ); diff --git a/lib/ppx/Form_UseFormFn_UpdateActions_AsyncFieldInOnBlurMode.re b/lib/ppx/Form_UseFormFn_UpdateActions_AsyncFieldInOnBlurMode.re new file mode 100644 index 00000000..6b10d8f3 --- /dev/null +++ b/lib/ppx/Form_UseFormFn_UpdateActions_AsyncFieldInOnBlurMode.re @@ -0,0 +1,128 @@ +open Meta; +open Ast; +open AstHelpers; + +open Ppxlib; +open Ast_helper; + +let ast = + ( + ~loc, + ~kind: [ | `Field | `FieldOfCollection], + ~optionality: option(FieldOptionality.t), + ~field_status_expr: expression, + ~validator_expr: expression, + ~set_status_expr: expression, + ) => [%expr + Update({ + ...state, + input, + fieldsStatuses: + switch%e (optionality) { + | None => + switch (kind) { + | `Field => + %expr + { + Async.validateFieldOnChangeInOnBlurMode( + ~input, + ~fieldStatus=[%e field_status_expr], + ~submissionStatus=state.submissionStatus, + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + | `FieldOfCollection => + %expr + { + Async.validateFieldOfCollectionOnChangeInOnBlurMode( + ~input, + ~index, + ~fieldStatus=[%e field_status_expr], + ~submissionStatus=state.submissionStatus, + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + } + | Some(OptionType) => + switch (kind) { + | `Field => + %expr + { + Async.validateFieldOfOptionTypeOnChangeInOnBlurMode( + ~input, + ~fieldStatus=[%e field_status_expr], + ~submissionStatus=state.submissionStatus, + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + | `FieldOfCollection => + %expr + { + Async.validateFieldOfCollectionOfOptionTypeOnChangeInOnBlurMode( + ~input, + ~index, + ~fieldStatus=[%e field_status_expr], + ~submissionStatus=state.submissionStatus, + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + } + | Some(StringType) => + switch (kind) { + | `Field => + %expr + { + Async.validateFieldOfStringTypeOnChangeInOnBlurMode( + ~input, + ~fieldStatus=[%e field_status_expr], + ~submissionStatus=state.submissionStatus, + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + | `FieldOfCollection => + %expr + { + Async.validateFieldOfCollectionOfStringTypeOnChangeInOnBlurMode( + ~input, + ~index, + ~fieldStatus=[%e field_status_expr], + ~submissionStatus=state.submissionStatus, + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + } + | Some(OptionStringType) => + switch (kind) { + | `Field => + %expr + { + Async.validateFieldOfOptionStringTypeOnChangeInOnBlurMode( + ~input, + ~fieldStatus=[%e field_status_expr], + ~submissionStatus=state.submissionStatus, + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + | `FieldOfCollection => + %expr + { + Async.validateFieldOfCollectionOfOptionStringTypeOnChangeInOnBlurMode( + ~input, + ~index, + ~fieldStatus=[%e field_status_expr], + ~submissionStatus=state.submissionStatus, + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + } + }, + }) +]; diff --git a/lib/ppx/Form_UseFormFn_UpdateActions_AsyncFieldInOnChangeMode.re b/lib/ppx/Form_UseFormFn_UpdateActions_AsyncFieldInOnChangeMode.re new file mode 100644 index 00000000..68ea519a --- /dev/null +++ b/lib/ppx/Form_UseFormFn_UpdateActions_AsyncFieldInOnChangeMode.re @@ -0,0 +1,141 @@ +open Meta; +open Ast; +open AstHelpers; + +open Ppxlib; +open Ast_helper; + +let ast = + ( + ~loc, + ~kind: [ | `Field | `FieldOfCollection], + ~field: Scheme.field, + ~optionality: option(FieldOptionality.t), + ~field_status_expr: expression, + ~validator_expr: expression, + ~set_status_expr: expression, + ) => { + %expr + { + let nextFieldsStatuses = + switch%e (optionality) { + | None => + switch (kind) { + | `Field => + %expr + { + Async.validateFieldOnChangeInOnChangeMode( + ~input, + ~fieldStatus=[%e field_status_expr], + ~submissionStatus=state.submissionStatus, + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + | `FieldOfCollection => + %expr + { + Async.validateFieldOfCollectionOnChangeInOnChangeMode( + ~input, + ~index, + ~fieldStatus=[%e field_status_expr], + ~submissionStatus=state.submissionStatus, + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + } + | Some(OptionType) => + switch (kind) { + | `Field => + %expr + { + Async.validateFieldOfOptionTypeOnChangeInOnChangeMode( + ~input, + ~fieldStatus=[%e field_status_expr], + ~submissionStatus=state.submissionStatus, + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + | `FieldOfCollection => + %expr + { + Async.validateFieldOfCollectionOfOptionTypeOnChangeInOnChangeMode( + ~input, + ~index, + ~fieldStatus=[%e field_status_expr], + ~submissionStatus=state.submissionStatus, + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + } + | Some(StringType) => + switch (kind) { + | `Field => + %expr + { + Async.validateFieldOfStringTypeOnChangeInOnChangeMode( + ~input, + ~fieldStatus=[%e field_status_expr], + ~submissionStatus=state.submissionStatus, + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + | `FieldOfCollection => + %expr + { + Async.validateFieldOfCollectionOfStringTypeOnChangeInOnChangeMode( + ~input, + ~index, + ~fieldStatus=[%e field_status_expr], + ~submissionStatus=state.submissionStatus, + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + } + | Some(OptionStringType) => + switch (kind) { + | `Field => + %expr + { + Async.validateFieldOfOptionStringTypeOnChangeInOnChangeMode( + ~input, + ~fieldStatus=[%e field_status_expr], + ~submissionStatus=state.submissionStatus, + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + | `FieldOfCollection => + %expr + { + Async.validateFieldOfCollectionOfOptionStringTypeOnChangeInOnChangeMode( + ~input, + ~index, + ~fieldStatus=[%e field_status_expr], + ~submissionStatus=state.submissionStatus, + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + } + }; + switch ([%e field.name |> E.field(~of_="nextFieldsStatuses", ~loc)]) { + | Validating(value) => + UpdateWithSideEffects( + {...state, input, fieldsStatuses: nextFieldsStatuses}, + ({dispatch}) => { + let validator = [%e field.name |> E.field(~of_="validators", ~loc)]; + validator.validateAsync((value, dispatch)); + }, + ) + | Pristine + | Dirty(_, Shown | Hidden) => + Update({...state, input, fieldsStatuses: nextFieldsStatuses}) + }; + }; +}; diff --git a/lib/ppx/Form_UseFormFn_UpdateActions_AsyncOnBlurMode.re b/lib/ppx/Form_UseFormFn_UpdateActions_AsyncOnBlurMode.re deleted file mode 100644 index a5bd782c..00000000 --- a/lib/ppx/Form_UseFormFn_UpdateActions_AsyncOnBlurMode.re +++ /dev/null @@ -1,67 +0,0 @@ -open Meta; -open Ast; -open AstHelpers; - -open Ppxlib; -open Ast_helper; - -let ast = - ( - ~loc, - ~optionality: option(FieldOptionality.t), - ~field_status_expr: expression, - ~validator_expr: expression, - ~set_status_expr: expression, - ) => [%expr - Update({ - ...state, - input, - fieldsStatuses: - switch%e (optionality) { - | None => - %expr - { - Async.validateFieldOnChangeInOnBlurMode( - ~input, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | Some(OptionType) => - %expr - { - Async.validateFieldOfOptionTypeOnChangeInOnBlurMode( - ~input, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | Some(StringType) => - %expr - { - Async.validateFieldOfStringTypeOnChangeInOnBlurMode( - ~input, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | Some(OptionStringType) => - %expr - { - Async.validateFieldOfOptionStringTypeOnChangeInOnBlurMode( - ~input, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - }, - }) -]; diff --git a/lib/ppx/Form_UseFormFn_UpdateActions_AsyncOnChangeMode.re b/lib/ppx/Form_UseFormFn_UpdateActions_AsyncOnChangeMode.re deleted file mode 100644 index b51239c4..00000000 --- a/lib/ppx/Form_UseFormFn_UpdateActions_AsyncOnChangeMode.re +++ /dev/null @@ -1,80 +0,0 @@ -open Meta; -open Ast; -open AstHelpers; - -open Ppxlib; -open Ast_helper; - -let ast = - ( - ~loc, - ~field: Field.t, - ~optionality: option(FieldOptionality.t), - ~field_status_expr: expression, - ~validator_expr: expression, - ~set_status_expr: expression, - ) => { - %expr - { - let nextFieldsStatuses = - switch%e (optionality) { - | None => - %expr - { - Async.validateFieldOnChangeInOnChangeMode( - ~input, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | Some(OptionType) => - %expr - { - Async.validateFieldOfOptionTypeOnChangeInOnChangeMode( - ~input, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | Some(StringType) => - %expr - { - Async.validateFieldOfStringTypeOnChangeInOnChangeMode( - ~input, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | Some(OptionStringType) => - %expr - { - Async.validateFieldOfOptionStringTypeOnChangeInOnChangeMode( - ~input, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - }; - switch ([%e field |> E.field(~of_="nextFieldsStatuses", ~loc)]) { - | Validating(value) => - UpdateWithSideEffects( - {...state, input, fieldsStatuses: nextFieldsStatuses}, - ({dispatch}) => { - let validator = [%e field |> E.field(~of_="validators", ~loc)]; - validator.validateAsync((value, dispatch)); - }, - ) - | Pristine - | Dirty(_, Shown | Hidden) => - Update({...state, input, fieldsStatuses: nextFieldsStatuses}) - }; - }; -}; diff --git a/lib/ppx/Form_UseFormFn_UpdateActions_DependentFields.re b/lib/ppx/Form_UseFormFn_UpdateActions_DependentFields.re new file mode 100644 index 00000000..27bcad17 --- /dev/null +++ b/lib/ppx/Form_UseFormFn_UpdateActions_DependentFields.re @@ -0,0 +1,230 @@ +open Meta; +open Ast; +open AstHelpers; + +open Ppxlib; +open Ast_helper; + +let ast = + ( + ~loc, + ~dep: FieldDep.t, + ~deps: list(FieldDep.t), + ~field as + field_being_updated: [ + | `Field(string) + | `FieldOfCollection(Collection.t, string) + ], + ~scheme: Scheme.t, + ) => { + let validate_dep = (dep: FieldDep.t) => { + switch ( + scheme + |> List.fold_left( + (res, entry: Scheme.entry) => + switch (res, entry, dep) { + | (Some(_), _, _) => res + | (None, Field(field), DepField(dep)) => + field.name == dep ? Some(`DepField(field)) : None + | ( + None, + Collection({collection, fields}), + DepFieldOfCollection({ + collection: dep_collection, + field: dep_field, + }), + ) => + if (collection.plural != dep_collection.plural) { + None; + } else { + Some( + `DepFieldOfCollection(( + collection, + fields + |> List.find((field: Scheme.field) => + field.name == dep_field + ), + )), + ); + } + | (None, Collection(_), DepField(_)) + | (None, Field(_), DepFieldOfCollection(_)) => res + }, + None, + ) + ) { + | None => + failwith( + "Dep is not found in scheme. Please, file an issue with your use-case.", + ) + | Some(`DepField(field)) => + let field_status_expr = + field.name |> E.ref_field(~of_="nextFieldsStatuses", ~loc); + let validator_expr = field.name |> E.field(~of_="validators", ~loc); + let set_status_expr = + field.name + |> E.update_ref_field( + ~of_="nextFieldsStatuses", + ~with_=[%expr status], + ~loc, + ); + + switch (field.validator) { + | SyncValidator(Ok(Required | Optional(Some(_))) | Error ()) => + switch%expr ( + validateDependentFieldOnChange( + ~input, + ~fieldStatus=[%e field_status_expr], + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ) + ) { + | Some(result) => nextFieldsStatuses := result + | None => () + } + | SyncValidator(Ok(Optional(None))) => + %expr + () + // Should we trigger async validator of dependency? + | AsyncValidator({mode: OnChange | OnBlur}) => + switch%expr ( + Async.validateDependentFieldOnChange( + ~input, + ~fieldStatus=[%e field_status_expr], + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ) + ) { + | Some(result) => nextFieldsStatuses := result + | None => () + } + }; + | Some(`DepFieldOfCollection(collection, field)) => + let collection_statuses_expr = + collection.plural |> E.ref_field(~of_="nextFieldsStatuses", ~loc); + let field_status_expr = field.name |> E.field(~of_="item", ~loc); + let validator_expr = + field.name + |> E.field_of_collection_validator( + ~validators="validators", + ~collection, + ~loc, + ); + let set_status_expr = + field.name + |> E.update_ref_field_in_collection( + ~of_="nextFieldsStatuses", + ~collection, + ~with_=[%expr status], + ~index_token="index'", + ~loc, + ); + + switch (field_being_updated) { + | `FieldOfCollection(collection', field') + when collection.plural == collection'.plural && field.name == field' => + switch (field.validator) { + | SyncValidator(Ok(Required | Optional(Some(_))) | Error ()) => + %expr + { + Belt.Array.forEachWithIndex( + [%e collection_statuses_expr], (index', item) => + if (index != index') { + switch ( + validateDependentFieldOfCollectionOnChange( + ~input, + ~index=index', + ~fieldStatus=[%e field_status_expr], + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ) + ) { + | Some(result) => nextFieldsStatuses := result + | None => () + }; + } else { + (); + } + ); + } + + | SyncValidator(Ok(Optional(None))) => + %expr + () + // Should we trigger async validator of dependency? + | AsyncValidator({mode: OnChange | OnBlur}) => + %expr + { + Belt.Array.forEachWithIndex( + [%e collection_statuses_expr], (index', item) => + if (index != index') { + switch ( + Async.validateDependentFieldOfCollectionOnChange( + ~input, + ~index=index', + ~fieldStatus=[%e field_status_expr], + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ) + ) { + | Some(result) => nextFieldsStatuses := result + | None => () + }; + } else { + (); + } + ); + } + } + | `FieldOfCollection(_, _) + | `Field(_) => + switch (field.validator) { + | SyncValidator(Ok(Required | Optional(Some(_))) | Error ()) => + %expr + { + Belt.Array.forEachWithIndex( + [%e collection_statuses_expr], (index', item) => + switch ( + validateDependentFieldOfCollectionOnChange( + ~input, + ~index=index', + ~fieldStatus=[%e field_status_expr], + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ) + ) { + | Some(result) => nextFieldsStatuses := result + | None => () + } + ); + } + | SyncValidator(Ok(Optional(None))) => + %expr + () + // Should we trigger async validator of dependency? + | AsyncValidator({mode: OnChange | OnBlur}) => + %expr + { + Belt.Array.forEachWithIndex( + [%e collection_statuses_expr], (index', item) => + switch ( + Async.validateDependentFieldOfCollectionOnChange( + ~input, + ~index=index', + ~fieldStatus=[%e field_status_expr], + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ) + ) { + | Some(result) => nextFieldsStatuses := result + | None => () + } + ); + } + } + }; + }; + }; + + deps |> E.seq(~exp=dep |> validate_dep, ~make=validate_dep); +}; diff --git a/lib/ppx/Form_UseFormFn_UpdateActions_Deps.re b/lib/ppx/Form_UseFormFn_UpdateActions_Deps.re deleted file mode 100644 index 4549effb..00000000 --- a/lib/ppx/Form_UseFormFn_UpdateActions_Deps.re +++ /dev/null @@ -1,66 +0,0 @@ -open Meta; -open Ast; -open AstHelpers; - -open Ppxlib; -open Ast_helper; - -let ast = (~loc, ~dep: Field.t, ~deps: list(Field.t), ~scheme: Scheme.t) => { - let validate_dep = (dep: Field.t) => { - let (dep_field, dep_validator) = - switch ( - scheme - |> List.find((entry: Scheme.entry) => - switch (entry, dep) { - | (Field({name}), Field(dep)) => name == dep - } - ) - ) { - | Field({name, validator}) => (Field.Field(name), validator) - }; - - let field_status_expr = - dep_field |> E.ref_field(~of_="nextFieldsStatuses", ~loc); - let validator_expr = dep_field |> E.field(~of_="validators", ~loc); - let set_status_expr = - dep_field - |> E.update_ref_field( - ~of_="nextFieldsStatuses", - ~with_=[%expr status], - ~loc, - ); - - switch (dep_validator) { - | SyncValidator(Ok(Required | Optional(Some(_))) | Error ()) => - switch%expr ( - validateFieldDependencyOnChange( - ~input, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - ) { - | Some(result) => nextFieldsStatuses := result - | None => () - } - | SyncValidator(Ok(Optional(None))) => - %expr - () - // Should we trigger async validator of dependency? - | AsyncValidator({mode: OnChange | OnBlur}) => - switch%expr ( - Async.validateFieldDependencyOnChange( - ~input, - ~fieldStatus=[%e field_status_expr], - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - ) { - | Some(result) => nextFieldsStatuses := result - | None => () - } - }; - }; - - deps |> E.seq(~exp=dep |> validate_dep, ~make=validate_dep); -}; diff --git a/lib/ppx/Form_UseFormFn_UpdateActions_Sync.re b/lib/ppx/Form_UseFormFn_UpdateActions_Sync.re deleted file mode 100644 index 9f626457..00000000 --- a/lib/ppx/Form_UseFormFn_UpdateActions_Sync.re +++ /dev/null @@ -1,42 +0,0 @@ -open Meta; -open Ast; -open AstHelpers; - -open Ppxlib; -open Ast_helper; - -let ast = - ( - ~loc, - ~validator: result(FieldValidator.sync, unit), - ~field_status_expr: expression, - ~field_input_expr: expression, - ~validator_expr: expression, - ~set_status_expr: expression, - ) => [%expr - Update({ - ...state, - input, - fieldsStatuses: - switch%e (validator) { - | Ok(Required | Optional(Some(_))) - | Error () => - %expr - { - validateFieldOnChangeWithValidator( - ~input, - ~fieldStatus=[%e field_status_expr], - ~submissionStatus=state.submissionStatus, - ~validator=[%e validator_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ); - } - | Ok(Optional(None)) => - %expr - validateFieldOnChangeWithoutValidator( - ~fieldInput=[%e field_input_expr], - ~setStatus=[%e [%expr status => [%e set_status_expr]]], - ) - }, - }) -]; diff --git a/lib/ppx/Form_UseFormFn_UpdateActions_SyncField.re b/lib/ppx/Form_UseFormFn_UpdateActions_SyncField.re new file mode 100644 index 00000000..c22a05ce --- /dev/null +++ b/lib/ppx/Form_UseFormFn_UpdateActions_SyncField.re @@ -0,0 +1,58 @@ +open Meta; +open Ast; +open AstHelpers; + +open Ppxlib; +open Ast_helper; + +let ast = + ( + ~loc, + ~kind: [ | `Field | `FieldOfCollection], + ~validator: result(FieldValidator.sync, unit), + ~field_status_expr: expression, + ~field_input_expr: expression, + ~validator_expr: expression, + ~set_status_expr: expression, + ) => [%expr + Update({ + ...state, + input, + fieldsStatuses: + switch%e (validator) { + | Ok(Required | Optional(Some(_))) + | Error () => + switch (kind) { + | `Field => + %expr + { + validateFieldOnChangeWithValidator( + ~input, + ~fieldStatus=[%e field_status_expr], + ~submissionStatus=state.submissionStatus, + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + | `FieldOfCollection => + %expr + { + validateFieldOfCollectionOnChangeWithValidator( + ~input, + ~index, + ~fieldStatus=[%e field_status_expr], + ~submissionStatus=state.submissionStatus, + ~validator=[%e validator_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ); + } + } + | Ok(Optional(None)) => + %expr + validateFieldOnChangeWithoutValidator( + ~fieldInput=[%e field_input_expr], + ~setStatus=[%e [%expr status => [%e set_status_expr]]], + ) + }, + }) +]; diff --git a/lib/ppx/Form_ValidateFormFn.re b/lib/ppx/Form_ValidateFormFn.re new file mode 100644 index 00000000..73aa8482 --- /dev/null +++ b/lib/ppx/Form_ValidateFormFn.re @@ -0,0 +1,949 @@ +open Meta; +open Ast; +open AstHelpers; +open Printer; + +open Ppxlib; +open Ast_helper; + +let field_result = (~field: string) => field ++ "Result"; +let field_result_visibility = (~field: string) => field ++ "ResultVisibility"; +let collection_result = (collection: Collection.t) => + collection.plural ++ "Result"; +let collection_fields_statuses = (collection: Collection.t) => + collection.plural ++ "FieldsStatuses"; + +let validate_field_without_validator = (~field: Scheme.field, ~loc) => [%expr + (Ok([%e field.name |> E.field(~of_="input", ~loc)]), Hidden) +]; + +let validate_field_of_collection_without_validator = + (~collection: Collection.t, ~field: Scheme.field, ~loc) => [%expr + ( + Ok( + [%e + Exp.field( + [%expr + Array.getUnsafe( + [%e collection.plural |> E.field(~of_="input", ~loc)], + index, + ) + ], + Lident(field.name) |> lid(~loc), + ) + ], + ), + Hidden, + ) +]; + +let validate_field_with_sync_validator = (~field: Scheme.field, ~loc) => [%expr + ( + switch ([%e field.name |> E.field(~of_="fieldsStatuses", ~loc)]) { + | Pristine => + let validator = [%e field.name |> E.field(~of_="validators", ~loc)]; + validator.validate(input); + | Dirty(result, _) => result + }, + Shown, + ) +]; + +let validate_field_of_collection_with_sync_validator = + (~field: Scheme.field, ~collection: Collection.t, ~loc) => [%expr + ( + switch ([%e field.name |> E.field(~of_="fieldStatus", ~loc)]) { + | Pristine => + let validator = [%e + field.name + |> E.field_of_collection_validator( + ~validators="validators", + ~collection, + ~loc, + ) + ]; + validator.validate(input, ~at=index); + | Dirty(result, _) => result + }, + Shown, + ) +]; + +let validate_field_with_async_validator = (~field: Scheme.field, ~loc) => [%expr + ( + switch ([%e field.name |> E.field(~of_="fieldsStatuses", ~loc)]) { + | Validating(value) => `Validating(value) + | Pristine => + // If field is not touched, it either "empty" or has initial input + // If async field optional, then empty state is valid + // If it has initial value, in general it's from a server, hence valid + // If it's not from server and sync validator returned OK() but value is invalid, + // it should be rejected by the server on submit anyway + // So it doesn't worth to do 2+ requests on submission + let validator = [%e field.name |> E.field(~of_="validators", ~loc)]; + `Result(validator.validate(input)); + | Dirty(result, _) => + // This field was updated by user so all its validators already run + `Result(result) + }, + Shown, + ) +]; + +let validate_field_of_collection_with_async_validator = + (~field: Scheme.field, ~collection: Collection.t, ~loc) => [%expr + ( + switch ([%e field.name |> E.field(~of_="fieldStatus", ~loc)]) { + | Validating(value) => `Validating(value) + | Dirty(result, _) => `Result(result) + | Pristine => + let validator = [%e + field.name + |> E.field_of_collection_validator( + ~validators="validators", + ~collection, + ~loc, + ) + ]; + `Result(validator.validate(input, ~at=index)); + }, + Shown, + ) +]; + +let ok_pat_for_sync_field = (~loc, field: Scheme.field) => + Pat.tuple([ + Pat.alias( + Pat.construct( + ~attrs=[explicit_arity(~loc)], + Lident("Ok") |> lid(~loc), + Some(Pat.tuple([Pat.var(field.name |> str(~loc))])), + ), + field_result(~field=field.name) |> str(~loc), + ), + Pat.var(field_result_visibility(~field=field.name) |> str(~loc)), + ]); + +let ok_pat_for_async_field = (~loc, field: Scheme.field) => + Pat.tuple([ + Pat.variant( + "Result", + Some( + Pat.alias( + Pat.construct( + ~attrs=[explicit_arity(~loc)], + Lident("Ok") |> lid(~loc), + Some(Pat.tuple([Pat.var(field.name |> str(~loc))])), + ), + field_result(~field=field.name) |> str(~loc), + ), + ), + ), + Pat.var(field_result_visibility(~field=field.name) |> str(~loc)), + ]); + +let ok_pat_for_async_collection = (~loc, collection: Collection.t) => + Pat.variant( + "CollectionResult", + Some( + Pat.alias( + Pat.construct( + ~attrs=[explicit_arity(~loc)], + Lident("Ok") |> lid(~loc), + Some(Pat.tuple([Pat.var(collection.plural |> str(~loc))])), + ), + collection |> collection_fields_statuses |> str(~loc), + ), + ), + ); + +let result_and_visibility_pat_for_field = (~loc, field: Scheme.field) => + Pat.tuple([ + Pat.var(field_result(~field=field.name) |> str(~loc)), + Pat.var(field_result_visibility(~field=field.name) |> str(~loc)), + ]); + +let result_and_visibility_pat_for_async_field = (~loc, field: Scheme.field) => + Pat.tuple([ + Pat.variant( + "Result", + Some(Pat.var(field_result(~field=field.name) |> str(~loc))), + ), + Pat.var(field_result_visibility(~field=field.name) |> str(~loc)), + ]); + +let result_pat_for_collection = (~loc, collection: Collection.t) => + Pat.var(collection |> collection_result |> str(~loc)); + +let fields_statuses_pat_for_async_collection = + (~loc, collection: Collection.t) => + Pat.variant( + "CollectionResult", + Some( + Pat.tuple([ + Pat.any(), + Pat.var(collection |> collection_fields_statuses |> str(~loc)), + ]), + ), + ); + +let ok_pat_for_collection = (~loc, collection: Collection.t) => + Pat.tuple([ + Pat.construct( + ~attrs=[explicit_arity(~loc)], + Lident("Ok") |> lid(~loc), + Some(Pat.tuple([Pat.var(collection.plural |> str(~loc))])), + ), + Pat.var(collection |> collection_fields_statuses |> str(~loc)), + ]); + +let error_pat_for_collection = (~loc, collection: Collection.t) => + Pat.tuple([ + Pat.any(), + Pat.var(collection |> collection_fields_statuses |> str(~loc)), + ]); + +let output_field = (~loc, field: Scheme.field) => ( + Lident(field.name) |> lid(~loc), + Exp.ident(Lident(field.name) |> lid(~loc)), +); + +let output_collection = (~loc, collection: Collection.t) => ( + Lident(collection.plural) |> lid(~loc), + Exp.ident(Lident(collection.plural) |> lid(~loc)), +); + +let field_dirty_status = (~loc, field: Scheme.field) => ( + Lident(field.name) |> lid(~loc), + [%expr + Dirty( + [%e Exp.ident(Lident(field_result(~field=field.name)) |> lid(~loc))], + [%e + Exp.ident( + Lident(field_result_visibility(~field=field.name)) |> lid(~loc), + ) + ], + ) + ], +); + +let async_field_dirty_or_validating_status = (~loc, field: Scheme.field) => ( + Lident(field.name) |> lid(~loc), + switch%expr ( + [%e Exp.ident(Lident(field_result(~field=field.name)) |> lid(~loc))] + ) { + | `Validating(value) => Validating(value) + | `Result(result) => + Dirty( + result, + [%e + Exp.ident( + Lident(field_result_visibility(~field=field.name)) |> lid(~loc), + ) + ], + ) + }, +); + +let collection_that_might_be_in_validating_state_status = + (~loc, collection: Collection.t) => ( + Lident(collection.plural) |> lid(~loc), + switch%expr ( + [%e Exp.ident(Lident(collection |> collection_result) |> lid(~loc))] + ) { + | `ValidatingCollection(statuses) => statuses + | `CollectionResult(_, statuses) => statuses + }, +); + +let collection_statuses = (~loc, collection: Collection.t) => ( + Lident(collection.plural) |> lid(~loc), + Exp.ident(Lident(collection |> collection_fields_statuses) |> lid(~loc)), +); + +let validate_sync_collection = + ( + ~collection: Collection.t, + ~fields: list(Scheme.field), + ~output_type: ItemType.t, + ~loc: Location.t, + ) => { + let match_values = + Exp.tuple([ + [%expr output], + ...fields + |> List.map((field: Scheme.field) => + switch (field.validator) { + | SyncValidator(Ok(Required | Optional(Some(_))) | Error ()) => + validate_field_of_collection_with_sync_validator( + ~collection, + ~field, + ~loc, + ) + | SyncValidator(Ok(Optional(None))) => + validate_field_of_collection_without_validator( + ~collection, + ~field, + ~loc, + ) + | AsyncValidator(_) => + failwith( + "Form that supposed to be without async validators has one. Please, file an issue with yoour use-case.", + ) + } + ), + ]); + + let ok_case = + Exp.case( + Pat.tuple([ + Pat.construct( + ~attrs=[explicit_arity(~loc)], + Lident("Ok") |> lid(~loc), + Some(Pat.tuple([Pat.var("output" |> str(~loc))])), + ), + ...fields |> List.map(ok_pat_for_sync_field(~loc)), + ]), + [%expr + { + ignore( + Js.Array2.push( + output, + [%e Exp.record(fields |> List.map(output_field(~loc)), None)], + ), + ); + ignore( + Js.Array2.push( + statuses, + [%e + Exp.record( + fields |> List.map(field_dirty_status(~loc)), + None, + ) + ], + ), + ); + (Ok(output), statuses); + } + ], + ); + + let error_case = + Exp.case( + Pat.tuple([ + Pat.any(), + ...fields |> List.map(result_and_visibility_pat_for_field(~loc)), + ]), + [%expr + { + ignore( + Js.Array2.push( + statuses, + [%e + Exp.record( + fields |> List.map(field_dirty_status(~loc)), + None, + ) + ], + ), + ); + (Error(), statuses); + } + ], + ); + + %expr + { + Belt.Array.reduceWithIndex( + [%e collection.plural |> E.field(~of_="fieldsStatuses", ~loc)], + (Ok([||]), [||]), + ( + ( + output: result(array([%t output_type |> ItemType.unpack]), unit), + statuses: + array( + [%t + Typ.constr( + Lident(collection |> CollectionPrinter.fields_statuses_type) + |> lid(~loc), + [], + ) + ], + ), + ), + fieldStatus, + index, + ) => { + %e + Exp.match(match_values, [ok_case, error_case]) + }); + }; +}; + +let validate_async_collection = + ( + ~collection: Collection.t, + ~fields: list(Scheme.field), + ~output_type: ItemType.t, + ~loc: Location.t, + ) => { + let fields_statuses_type = + Typ.constr( + Lident(collection |> CollectionPrinter.fields_statuses_type) + |> lid(~loc), + [], + ); + + let match_values = + Exp.tuple([ + [%expr result], + ...fields + |> List.map((field: Scheme.field) => + switch (field.validator) { + | SyncValidator(Ok(Required | Optional(Some(_))) | Error ()) => + validate_field_of_collection_with_sync_validator( + ~collection, + ~field, + ~loc, + ) + | SyncValidator(Ok(Optional(None))) => + validate_field_of_collection_without_validator( + ~collection, + ~field, + ~loc, + ) + | AsyncValidator(_) => + validate_field_of_collection_with_async_validator( + ~collection, + ~field, + ~loc, + ) + } + ), + ]); + + let validating_case = + Exp.case( + P.or_( + ~pat= + Pat.tuple([ + [%pat? `ValidatingCollection(statuses)], + ...fields |> List.map(result_and_visibility_pat_for_field(~loc)), + ]), + ~make= + (field: Scheme.field) => + Pat.tuple([ + [%pat? `CollectionResult(_, statuses)], + ...fields + |> List.map((field': Scheme.field) => + if (field'.name == field.name) { + Pat.tuple([ + Pat.alias( + Pat.variant("Validating", Some(Pat.any())), + field_result(~field=field.name) |> str(~loc), + ), + Pat.var( + field_result_visibility(~field=field.name) + |> str(~loc), + ), + ]); + } else { + field' |> result_and_visibility_pat_for_field(~loc); + } + ), + ]), + fields + |> List.filter((field: Scheme.field) => + switch (field.validator) { + | SyncValidator(_) => false + | AsyncValidator(_) => true + } + ), + ), + [%expr + { + ignore( + Js.Array2.push( + statuses, + [%e + Exp.record( + fields + |> List.map((field: Scheme.field) => + switch (field.validator) { + | SyncValidator(_) => field |> field_dirty_status(~loc) + | AsyncValidator(_) => + field |> async_field_dirty_or_validating_status(~loc) + } + ), + None, + ) + ], + ), + ); + `ValidatingCollection(statuses); + } + ], + ); + + let ok_case = + Exp.case( + Pat.tuple([ + [%pat? `CollectionResult(Ok(output), statuses)], + ...fields + |> List.map((field: Scheme.field) => + switch (field.validator) { + | SyncValidator(_) => field |> ok_pat_for_sync_field(~loc) + | AsyncValidator(_) => field |> ok_pat_for_async_field(~loc) + } + ), + ]), + [%expr + { + ignore( + Js.Array2.push( + output, + [%e Exp.record(fields |> List.map(output_field(~loc)), None)], + ), + ); + ignore( + Js.Array2.push( + statuses, + [%e + Exp.record( + fields |> List.map(field_dirty_status(~loc)), + None, + ) + ], + ), + ); + `CollectionResult((Ok(output), statuses)); + } + ], + ); + + let error_case = + Exp.case( + Pat.tuple([ + [%pat? `CollectionResult(_, statuses)], + ...fields |> List.map(result_and_visibility_pat_for_field(~loc)), + ]), + [%expr + { + ignore( + Js.Array2.push( + statuses, + [%e + Exp.record( + fields + |> List.map((field: Scheme.field) => + switch (field.validator) { + | SyncValidator(_) => field |> field_dirty_status(~loc) + | AsyncValidator(_) => + field |> async_field_dirty_or_validating_status(~loc) + } + ), + None, + ) + ], + ), + ); + `CollectionResult((Error(), statuses)); + } + ], + ); + + %expr + { + Belt.Array.reduceWithIndex( + [%e collection.plural |> E.field(~of_="fieldsStatuses", ~loc)], + `CollectionResult((Ok([||]), [||])), + ( + result: [ + | `ValidatingCollection(array([%t fields_statuses_type])) + | `CollectionResult( + result(array([%t output_type |> ItemType.unpack]), unit), + array([%t fields_statuses_type]), + ) + ], + fieldStatus, + index, + ) => { + %e + Exp.match(match_values, [validating_case, ok_case, error_case]) + }); + }; +}; + +module Sync = { + let ast = (~loc, scheme: Scheme.t) => { + [%stri + let validateForm = + ( + input: input, + ~validators: validators, + ~fieldsStatuses: fieldsStatuses, + ) + : formValidationResult(output, fieldsStatuses) => { + %e + { + let match_values = + Exp.tuple( + scheme + |> List.map((entry: Scheme.entry) => + switch (entry) { + | Field( + { + validator: + SyncValidator( + Ok(Required | Optional(Some(_))) | Error (), + ), + } as field, + ) => + validate_field_with_sync_validator(~field, ~loc) + | Field( + {validator: SyncValidator(Ok(Optional(None)))} as field, + ) => + validate_field_without_validator(~field, ~loc) + | Field({name, validator: AsyncValidator(_)}) => + failwith( + "Form that supposed to be without async validators has one. Please, file an issue with yoour use-case.", + ) + | Collection({collection, fields, output_type}) => + validate_sync_collection( + ~collection, + ~fields, + ~output_type, + ~loc, + ) + } + ), + ); + + let ok_case = + Exp.case( + Pat.tuple( + scheme + |> List.map((entry: Scheme.entry) => + switch (entry) { + | Field(field) => field |> ok_pat_for_sync_field(~loc) + | Collection({collection}) => + collection |> ok_pat_for_collection(~loc) + } + ), + ), + [%expr + Valid({ + output: [%e + Exp.record( + scheme + |> List.map((entry: Scheme.entry) => + switch (entry) { + | Field(field) => field |> output_field(~loc) + | Collection({collection}) => + collection |> output_collection(~loc) + } + ), + None, + ) + ], + fieldsStatuses: [%e + Exp.record( + scheme + |> List.map((entry: Scheme.entry) => + switch (entry) { + | Field(field) => + field |> field_dirty_status(~loc) + | Collection({collection}) => + collection |> collection_statuses(~loc) + } + ), + None, + ) + ], + }) + ], + ); + + let error_case = + Exp.case( + Pat.tuple( + scheme + |> List.map((entry: Scheme.entry) => + switch (entry) { + | Field(field) => + field |> result_and_visibility_pat_for_field(~loc) + | Collection({collection}) => + collection |> error_pat_for_collection(~loc) + } + ), + ), + [%expr + Invalid({ + fieldsStatuses: [%e + Exp.record( + scheme + |> List.map((entry: Scheme.entry) => + switch (entry) { + | Field(field) => + field |> field_dirty_status(~loc) + | Collection({collection}) => + collection |> collection_statuses(~loc) + } + ), + None, + ) + ], + }) + ], + ); + + Exp.match(match_values, [ok_case, error_case]); + }; + } + ]; + }; +}; + +module Async = { + type validating_entry = [ + | `AsyncField(Scheme.field) + | `Collection(Collection.t) + ]; + + let ast = (~loc, scheme: Scheme.t) => { + [%stri + let validateForm = + ( + input: input, + ~validators: validators, + ~fieldsStatuses: fieldsStatuses, + ) + : Async.formValidationResult(output, fieldsStatuses) => { + %e + { + let match_values = + Exp.tuple( + scheme + |> List.map((entry: Scheme.entry) => + switch (entry) { + | Field( + { + validator: + SyncValidator( + Ok(Required | Optional(Some(_))) | Error (), + ), + } as field, + ) => + validate_field_with_sync_validator(~field, ~loc) + | Field( + {validator: SyncValidator(Ok(Optional(None)))} as field, + ) => + validate_field_without_validator(~field, ~loc) + | Field({validator: AsyncValidator(_)} as field) => + validate_field_with_async_validator(~field, ~loc) + | Collection({collection, fields, output_type}) => + validate_async_collection( + ~collection, + ~fields, + ~output_type, + ~loc, + ) + } + ), + ); + + let validating_case = { + let entries_might_be_in_validating_state: list(validating_entry) = + scheme + |> List.fold_left( + (acc, entry: Scheme.entry) => + switch (entry) { + | Field({validator: SyncValidator(_)}) => acc + | Field({validator: AsyncValidator(_)} as field) => [ + `AsyncField(field), + ...acc, + ] + | Collection({collection}) => [ + `Collection(collection), + ...acc, + ] + }, + [], + ); + let make = (entry: validating_entry) => + Pat.tuple( + switch (entry) { + | `AsyncField(current_field) => + scheme + |> List.map((entry: Scheme.entry) => + switch (entry) { + | Field({validator: AsyncValidator(_)} as field) + when field.name == current_field.name => + Pat.tuple([ + Pat.alias( + Pat.variant("Validating", Some(Pat.any())), + field_result(~field=field.name) |> str(~loc), + ), + Pat.var( + field_result_visibility(~field=field.name) + |> str(~loc), + ), + ]) + | Field( + {validator: SyncValidator(_) | AsyncValidator(_)} as field, + ) => + field |> result_and_visibility_pat_for_field(~loc) + | Collection({collection}) => + collection |> result_pat_for_collection(~loc) + } + ) + | `Collection(current_collection) => + scheme + |> List.map((entry: Scheme.entry) => + switch (entry) { + | Field(field) => + field |> result_and_visibility_pat_for_field(~loc) + | Collection({collection}) + when collection.plural == current_collection.plural => + Pat.alias( + Pat.variant( + "ValidatingCollection", + Some(Pat.any()), + ), + collection |> collection_result |> str(~loc), + ) + | Collection({collection}) => + collection |> result_pat_for_collection(~loc) + } + ) + }, + ); + Exp.case( + switch (entries_might_be_in_validating_state) { + | [] => + failwith( + "No entries found that might be in validating state. Please, file an issue with your use-case.", + ) + | [x] => x |> make + | [x, ...rest] => P.or_(~pat=x |> make, ~make, rest) + }, + [%expr + { + Validating({ + fieldsStatuses: [%e + Exp.record( + scheme + |> List.map((entry: Scheme.entry) => + switch (entry) { + | Field({validator: SyncValidator(_)} as field) => + field |> field_dirty_status(~loc) + | Field({validator: AsyncValidator(_)} as field) => + field + |> async_field_dirty_or_validating_status(~loc) + | Collection({collection}) => + collection + |> collection_that_might_be_in_validating_state_status( + ~loc, + ) + } + ), + None, + ) + ], + }); + } + ], + ); + }; + + let ok_case = + Exp.case( + Pat.tuple( + scheme + |> List.map((entry: Scheme.entry) => + switch (entry) { + | Field({validator: SyncValidator(_)} as field) => + field |> ok_pat_for_sync_field(~loc) + | Field({validator: AsyncValidator(_)} as field) => + field |> ok_pat_for_async_field(~loc) + | Collection({collection}) => + collection |> ok_pat_for_async_collection(~loc) + } + ), + ), + [%expr + Valid({ + output: [%e + Exp.record( + scheme + |> List.map((entry: Scheme.entry) => + switch (entry) { + | Field(field) => field |> output_field(~loc) + | Collection({collection}) => + collection |> output_collection(~loc) + } + ), + None, + ) + ], + fieldsStatuses: [%e + Exp.record( + scheme + |> List.map((entry: Scheme.entry) => + switch (entry) { + | Field(field) => + field |> field_dirty_status(~loc) + | Collection({collection}) => + collection |> collection_statuses(~loc) + } + ), + None, + ) + ], + }) + ], + ); + + let error_case = + Exp.case( + Pat.tuple( + scheme + |> List.map((entry: Scheme.entry) => + switch (entry) { + | Field({validator: SyncValidator(_)} as field) => + field |> result_and_visibility_pat_for_field(~loc) + | Field({validator: AsyncValidator(_)} as field) => + field + |> result_and_visibility_pat_for_async_field(~loc) + | Collection({collection}) => + collection + |> fields_statuses_pat_for_async_collection(~loc) + } + ), + ), + [%expr + Invalid({ + fieldsStatuses: [%e + Exp.record( + scheme + |> List.map((entry: Scheme.entry) => + switch (entry) { + | Field(field) => + field |> field_dirty_status(~loc) + | Collection({collection}) => + collection |> collection_statuses(~loc) + } + ), + None, + ) + ], + }) + ], + ); + + Exp.match(match_values, [validating_case, ok_case, error_case]); + }; + } + ]; + }; +}; diff --git a/lib/ppx/Form_ValidateFormFn_Async.re b/lib/ppx/Form_ValidateFormFn_Async.re deleted file mode 100644 index db0eb724..00000000 --- a/lib/ppx/Form_ValidateFormFn_Async.re +++ /dev/null @@ -1,345 +0,0 @@ -open Meta; -open Ast; -open AstHelpers; - -open Ppxlib; -open Ast_helper; - -let ast = (~loc, scheme: Scheme.t) => { - let field_result = x => (x |> Field.to_camelized_string) ++ "Result"; - let field_result_visibility = x => - (x |> Field.to_camelized_string) ++ "ResultVisibility"; - - // We are going to pattern match against validation results of each field - [%stri - let validateForm = - ( - input: input, - ~validators: validators, - ~fieldsStatuses: fieldsStatuses, - ) - : option(formValidationResult(output, fieldsStatuses)) => { - %e - { - let match_values = - Exp.tuple( - scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({ - name, - validator: - SyncValidator( - Ok(Required | Optional(Some(_))) | Error (), - ), - }) => - %expr - { - ( - switch ( - [%e - Field.Field(name) - |> E.field(~of_="fieldsStatuses", ~loc) - ] - ) { - | Pristine => - let validator = [%e - Field.Field(name) - |> E.field(~of_="validators", ~loc) - ]; - validator.validate(input); - | Dirty(result, _) => result - }, - Shown, - ); - } - | Field({ - name, - validator: SyncValidator(Ok(Optional(None))), - }) => - %expr - ( - Ok( - [%e Field.Field(name) |> E.field(~of_="input", ~loc)], - ), - Hidden, - ) - | Field({name, validator: AsyncValidator(_)}) => - %expr - { - ( - switch ( - [%e - Field.Field(name) - |> E.field(~of_="fieldsStatuses", ~loc) - ] - ) { - | Validating(x) => `Validating(x) - | Pristine => - // If field is not touched, it either "empty" or has initial input - // If async field optional, then empty state is valid - // If it has initial value, in general it's from a server, hence valid - // If it's not from server and sync validator returned OK() but value is invalid, - // it should be rejected by the server on submit anyway - // So it doesn't worth to do 2+ requests on submission - let validator = [%e - Field.Field(name) - |> E.field(~of_="validators", ~loc) - ]; - `Result(validator.validate(input)); - | Dirty(result, _) => - // This field was updated by user so all its validators already run - `Result(result) - }, - Shown, - ); - } - } - ), - ); - let validating_cases = - scheme - |> List.fold_left( - (acc, entry: Scheme.entry) => - switch (entry) { - | Field({validator: SyncValidator(_)}) => acc - | Field({name, validator: AsyncValidator(_)}) => [ - Exp.case( - Pat.tuple( - scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name: name'}) when name == name' => [%pat? - (`Validating(_), _) - ] - | Field(_) => [%pat? (_, _)] - } - ), - ), - [%expr None], - ), - ...acc, - ] - }, - [], - ); - - let ok_case = - Exp.case( - Pat.tuple( - scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name, validator: SyncValidator(_)}) => [%pat? - ( - [%p - Pat.alias( - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident("Ok") |> lid(~loc), - Some( - Pat.tuple([Pat.var(name |> str(~loc))]), - ), - ), - Field.Field(name) |> field_result |> str(~loc), - ) - ], - [%p - Pat.var( - Field.Field(name) - |> field_result_visibility - |> str(~loc), - ) - ], - ) - ] - | Field({name, validator: AsyncValidator(_)}) => [%pat? - ( - [%p - Pat.variant( - ~attrs=[explicit_arity(~loc)], - "Result", - Some( - Pat.alias( - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident("Ok") |> lid(~loc), - Some( - Pat.tuple([ - Pat.var(name |> str(~loc)), - ]), - ), - ), - Field.Field(name) - |> field_result - |> str(~loc), - ), - ), - ) - ], - [%p - Pat.var( - Field.Field(name) - |> field_result_visibility - |> str(~loc), - ) - ], - ) - ] - } - ), - ), - [%expr - Some( - Valid({ - output: [%e - Exp.record( - scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name}) => ( - Lident(name) |> lid(~loc), - Exp.ident(Lident(name) |> lid(~loc)), - ) - } - ), - None, - ) - ], - fieldsStatuses: [%e - Exp.record( - scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name}) => ( - Lident(name) |> lid(~loc), - [%expr - Dirty( - [%e - Exp.ident( - Lident( - Field.Field(name) |> field_result, - ) - |> lid(~loc), - ) - ], - [%e - Exp.ident( - Lident( - Field.Field(name) - |> field_result_visibility, - ) - |> lid(~loc), - ) - ], - ) - ], - ) - } - ), - None, - ) - ], - }), - ) - ], - ); - - let error_case = - Exp.case( - Pat.tuple( - scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name}) => - Pat.tuple([ - Pat.var( - Field.Field(name) |> field_result |> str(~loc), - ), - Pat.var( - Field.Field(name) - |> field_result_visibility - |> str(~loc), - ), - ]) - } - ), - ), - [%expr - Some( - Invalid({ - fieldsStatuses: [%e - Exp.record( - scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name, validator: SyncValidator(_)}) => ( - Lident(name) |> lid(~loc), - [%expr - Dirty( - [%e - Exp.ident( - Lident( - Field.Field(name) |> field_result, - ) - |> lid(~loc), - ) - ], - [%e - Exp.ident( - Lident( - Field.Field(name) - |> field_result_visibility, - ) - |> lid(~loc), - ) - ], - ) - ], - ) - | Field({name, validator: AsyncValidator(_)}) => ( - Lident(name) |> lid(~loc), - switch%expr ( - [%e - Exp.ident( - Lident( - Field.Field(name) |> field_result, - ) - |> lid(~loc), - ) - ] - ) { - | `Validating(x) => Validating(x) - | `Result(result) => - Dirty( - result, - [%e - Exp.ident( - Lident( - Field.Field(name) - |> field_result_visibility, - ) - |> lid(~loc), - ) - ], - ) - }, - ) - } - ), - None, - ) - ], - }), - ) - ], - ); - - Exp.match( - match_values, - List.append(validating_cases, [ok_case, error_case]), - ); - }; - } - ]; -}; diff --git a/lib/ppx/Form_ValidateFormFn_Sync.re b/lib/ppx/Form_ValidateFormFn_Sync.re deleted file mode 100644 index 0a45d087..00000000 --- a/lib/ppx/Form_ValidateFormFn_Sync.re +++ /dev/null @@ -1,217 +0,0 @@ -open Meta; -open Ast; -open AstHelpers; - -open Ppxlib; -open Ast_helper; - -let ast = (~loc, scheme: Scheme.t) => { - let field_result = x => (x |> Field.to_camelized_string) ++ "Result"; - let field_result_visibility = x => - (x |> Field.to_camelized_string) ++ "ResultVisibility"; - - [%stri - let validateForm = - ( - input: input, - ~validators: validators, - ~fieldsStatuses: fieldsStatuses, - ) - : formValidationResult(output, fieldsStatuses) => { - %e - { - let match_values = - Exp.tuple( - scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({ - name, - validator: - SyncValidator( - Ok(Required | Optional(Some(_))) | Error (), - ), - }) => - %expr - { - ( - switch ( - [%e - Field.Field(name) - |> E.field(~of_="fieldsStatuses", ~loc) - ] - ) { - | Pristine => - let validator = [%e - Field.Field(name) - |> E.field(~of_="validators", ~loc) - ]; - validator.validate(input); - | Dirty(result, _) => result - }, - Shown, - ); - } - | Field({ - name, - validator: SyncValidator(Ok(Optional(None))), - }) => - %expr - ( - Ok( - [%e Field.Field(name) |> E.field(~of_="input", ~loc)], - ), - Hidden, - ) - | Field({name, validator: AsyncValidator(_)}) => - failwith( - "Form that supposed to be without async validators has one. Please, file an issue with yoour use-case.", - ) - } - ), - ); - - let ok_case = - Exp.case( - Pat.tuple( - scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name}) => - Pat.tuple([ - Pat.alias( - Pat.construct( - ~attrs=[explicit_arity(~loc)], - Lident("Ok") |> lid(~loc), - Some(Pat.tuple([Pat.var(name |> str(~loc))])), - ), - Field.Field(name) |> field_result |> str(~loc), - ), - Pat.var( - Field.Field(name) - |> field_result_visibility - |> str(~loc), - ), - ]) - } - ), - ), - [%expr - Valid({ - output: [%e - Exp.record( - scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name}) => ( - Lident(name) |> lid(~loc), - Exp.ident(Lident(name) |> lid(~loc)), - ) - } - ), - None, - ) - ], - fieldsStatuses: [%e - Exp.record( - scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name}) => ( - Lident(name) |> lid(~loc), - [%expr - Dirty( - [%e - Exp.ident( - Lident( - Field.Field(name) |> field_result, - ) - |> lid(~loc), - ) - ], - [%e - Exp.ident( - Lident( - Field.Field(name) - |> field_result_visibility, - ) - |> lid(~loc), - ) - ], - ) - ], - ) - } - ), - None, - ) - ], - }) - ], - ); - - let error_case = - Exp.case( - Pat.tuple( - scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name}) => - Pat.tuple([ - Pat.var( - Field.Field(name) |> field_result |> str(~loc), - ), - Pat.var( - Field.Field(name) - |> field_result_visibility - |> str(~loc), - ), - ]) - } - ), - ), - [%expr - Invalid({ - fieldsStatuses: [%e - Exp.record( - scheme - |> List.map((entry: Scheme.entry) => - switch (entry) { - | Field({name}) => ( - Lident(name) |> lid(~loc), - [%expr - Dirty( - [%e - Exp.ident( - Lident( - Field.Field(name) |> field_result, - ) - |> lid(~loc), - ) - ], - [%e - Exp.ident( - Lident( - Field.Field(name) - |> field_result_visibility, - ) - |> lid(~loc), - ) - ], - ) - ], - ) - } - ), - None, - ) - ], - }) - ], - ); - - Exp.match(match_values, [ok_case, error_case]); - }; - } - ]; -}; diff --git a/lib/ppx/Form_ValidatorsRecord.re b/lib/ppx/Form_ValidatorsRecord.re index 4f9eecf5..c8a9e9b4 100644 --- a/lib/ppx/Form_ValidatorsRecord.re +++ b/lib/ppx/Form_ValidatorsRecord.re @@ -1,10 +1,141 @@ open Meta; open Ast; open AstHelpers; +open Printer; open Ppxlib; open Ast_helper; +let ensure_eq = (~loc, fields) => + if (fields + |> List.exists((({txt: lid}, _)) => + switch (lid) { + | Lident("eq") => true + | _ => false + } + )) { + fields; + } else { + [(Lident("eq") |> lid(~loc), [%expr (==)]), ...fields]; + }; + +let update_async_validator_of_field = + ( + ~field: string, + ~output_type: ItemType.t, + ~async_mode: AsyncMode.t, + ~validator_loc: Location.t, + fields, + ) => + fields + |> ensure_eq(~loc=validator_loc) + |> List.map(((v_lid, {pexp_loc: loc} as expr)) => + switch (v_lid) { + | {txt: Lident("validateAsync")} => + let fn = [%expr + ( + ((value, dispatch)) => { + let validate: + Async.validateAsyncFn( + [%t output_type |> ItemType.unpack], + message, + ) = [%e + expr + ]; + Async.validateAsync(~value, ~validate, ~andThen=res => { + dispatch( + [%e + Exp.construct( + Lident(FieldPrinter.apply_async_result_action(~field)) + |> lid(~loc), + Some( + Exp.tuple([ + Exp.ident(Lident("value") |> lid(~loc)), + Exp.ident(Lident("res") |> lid(~loc)), + ]), + ), + ) + ], + ) + }); + } + ) + ]; + ( + v_lid, + switch (async_mode) { + | OnBlur => fn + | OnChange => + %expr + Debouncer.make(~wait=debounceInterval, [%e fn]) + }, + ); + | _ => (v_lid, expr) + } + ); + +let update_async_validator_of_field_of_collection = + ( + ~field: string, + ~collection: Collection.t, + ~output_type: ItemType.t, + ~async_mode: AsyncMode.t, + ~validator_loc: Location.t, + fields, + ) => + fields + |> ensure_eq(~loc=validator_loc) + |> List.map(((v_lid, {pexp_loc: loc} as expr)) => + switch (v_lid) { + | {txt: Lident("validateAsync")} => + let fn = [%expr + ( + ((value, index, dispatch)) => { + let validate: + Async.validateAsyncFn( + [%t output_type |> ItemType.unpack], + message, + ) = [%e + expr + ]; + Async.validateAsync(~value, ~validate, ~andThen=res => { + dispatch( + [%e + Exp.construct( + Lident( + FieldOfCollectionPrinter.apply_async_result_action( + ~collection, + ~field, + ), + ) + |> lid(~loc), + Some( + Exp.tuple([ + Exp.ident(Lident("value") |> lid(~loc)), + Exp.ident(Lident("index") |> lid(~loc)), + Exp.ident(Lident("res") |> lid(~loc)), + ]), + ), + ) + ], + ) + }); + } + ) + ]; + ( + v_lid, + switch (async_mode) { + | OnBlur => fn + | OnChange => + %expr + Debouncer.make(~wait=debounceInterval, [%e fn]) + }, + ); + | _ => (v_lid, expr) + } + ); + // What we need to do here: // 1. Update values of optional validators: set them to () instead of None // 2. Wrap async validators so each dispatches appropriate action @@ -18,127 +149,203 @@ let ast = ) => { let fields = validators_record.fields - |> List.map(((flid, expr)) => - switch (flid) { - | {txt: Lident(field)} => + |> List.map(((f_lid, expr)) => + switch (f_lid) { + | {txt: Lident(key)} => let entry = scheme |> List.find_opt( fun - | Scheme.Field({name}) => name == field, + | Scheme.Field(field) => field.name == key + | Scheme.Collection({collection}) => + collection.plural == key, ); switch (entry) { - | Some(Field({name, validator, output_type})) => - switch (validator) { - | SyncValidator(Ok(Required)) => (flid, expr) - | SyncValidator(Ok(Optional(Some ()))) => (flid, expr) + | None => (f_lid, expr) + | Some(Field(field)) => + switch (field.validator) { + | SyncValidator(Ok(Required)) => (f_lid, expr) + | SyncValidator(Ok(Optional(Some ()))) => (f_lid, expr) | SyncValidator(Ok(Optional(None))) => let loc = expr.pexp_loc; - (flid, [%expr ()]); - | SyncValidator(Error ()) => (flid, expr) + (f_lid, [%expr ()]); + | SyncValidator(Error ()) => (f_lid, expr) | AsyncValidator({mode: async_mode}) => ( - flid, + f_lid, switch (expr) { | { pexp_desc: Pexp_record(fields, None), pexp_loc, pexp_loc_stack, pexp_attributes, - } => - let fields_with_eq = - if (fields - |> List.exists((({txt: lid}, _)) => - switch (lid) { - | Lident("eq") => true - | _ => false - } - )) { - fields; - } else { - let loc = pexp_loc; - [ - (Lident("eq") |> lid(~loc), [%expr (==)]), - ...fields, - ]; - }; - let fields_with_eq_and_wrapped_async_validator = - fields_with_eq - |> List.map(((vlid, {pexp_loc: loc} as expr)) => - switch (vlid) { - | {txt: Lident("validateAsync")} => - let fn = [%expr - ( - ((value, dispatch)) => { - Js.log2( - "Executed async validator with value:", - value, - ); - let validate: - Async.validateAsyncFn( - [%t output_type |> FieldType.unpack], - message, - ) = [%e - expr - ]; - Async.validateAsync( - ~value, ~validate, ~andThen=res => { - dispatch( - [%e - Exp.construct( - Lident( - Field.Field(name) - |> Field.apply_async_result_action, - ) - |> lid(~loc), - Some( - Exp.tuple([ - Exp.ident( - Lident("value") |> lid(~loc), - ), - Exp.ident( - Lident("res") |> lid(~loc), - ), - ]), - ), - ) - ], - ) - }); - } - ) - ]; - ( - vlid, - switch (async_mode) { - | OnBlur => fn - | OnChange => - %expr - Debouncer.make( - ~wait=debounceInterval, - [%e fn], - ) - }, - ); - | _ => (vlid, expr) - } - ); - { + } => { pexp_desc: Pexp_record( - fields_with_eq_and_wrapped_async_validator, + fields + |> update_async_validator_of_field( + ~field=field.name, + ~output_type=field.output_type, + ~async_mode, + ~validator_loc=pexp_loc, + ), None, ), pexp_loc, pexp_loc_stack, pexp_attributes, - }; + } | _ => expr }, ) } - | None => (flid, expr) + | Some( + Collection({ + collection, + fields: collection_fields, + validator: collection_validator, + }), + ) => ( + f_lid, + switch (expr) { + | { + pexp_desc: Pexp_record(collection_validator_fields, None), + pexp_loc, + pexp_loc_stack, + pexp_attributes, + } => + let fields = + collection_validator_fields + |> List.map(((c_lid, expr)) => + switch (c_lid) { + | {txt: Lident("collection")} => ( + c_lid, + switch (collection_validator) { + | Ok(Some ()) + | Error () => expr + | Ok(None) => + let loc = expr.pexp_loc; + %expr + (); + }, + ) + | {txt: Lident("fields")} => ( + c_lid, + switch (expr) { + | { + pexp_desc: + Pexp_record(field_validator_fields, None), + pexp_loc, + pexp_loc_stack, + pexp_attributes, + } => + let fields = + field_validator_fields + |> List.map(((f_lid, expr)) => + switch (f_lid) { + | {txt: Lident(key)} => + let field = + collection_fields + |> List.find_opt( + (field: Scheme.field) => + field.name == key + ); + switch (field) { + | None => (f_lid, expr) + | Some({ + validator: + SyncValidator(Ok(Required)), + }) => ( + f_lid, + expr, + ) + | Some({ + validator: + SyncValidator( + Ok(Optional(Some ())), + ), + }) => ( + f_lid, + expr, + ) + | Some({ + validator: + SyncValidator( + Ok(Optional(None)), + ), + }) => + let loc = expr.pexp_loc; + (f_lid, [%expr ()]); + | Some({ + validator: SyncValidator(Error ()), + }) => ( + f_lid, + expr, + ) + | Some( + { + validator: + AsyncValidator({ + mode: async_mode, + }), + } as field, + ) => ( + f_lid, + switch (expr) { + | { + pexp_desc: + Pexp_record(fields, None), + pexp_loc, + pexp_loc_stack, + pexp_attributes, + } => { + pexp_desc: + Pexp_record( + fields + |> update_async_validator_of_field_of_collection( + ~field=field.name, + ~collection, + ~output_type= + field.output_type, + ~async_mode, + ~validator_loc=pexp_loc, + ), + None, + ), + pexp_loc, + pexp_loc_stack, + pexp_attributes, + } + | _ => expr + }, + ) + }; + | {txt: _} => (f_lid, expr) + } + ); + { + pexp_desc: Pexp_record(fields, None), + pexp_loc, + pexp_loc_stack, + pexp_attributes, + }; + | _ => expr + }, + ) + | _ => (c_lid, expr) + } + ); + + { + pexp_desc: Pexp_record(fields, None), + pexp_loc, + pexp_loc_stack, + pexp_attributes, + }; + | _ => expr + }, + ) }; - | _ => (flid, expr) + | _ => (f_lid, expr) } ); { diff --git a/lib/ppx/Form_ValidatorsType.re b/lib/ppx/Form_ValidatorsType.re index f5c5764b..322cf60f 100644 --- a/lib/ppx/Form_ValidatorsType.re +++ b/lib/ppx/Form_ValidatorsType.re @@ -1,33 +1,133 @@ open Meta; open Ast; open AstHelpers; +open Printer; open Ppxlib; open Ast_helper; +let field_type = (~loc, field: Scheme.field) => + Type.field( + field.name |> str(~loc), + switch (field.validator) { + | SyncValidator(Ok(Required)) + | SyncValidator(Ok(Optional(Some(_)))) + | SyncValidator(Error ()) => [%type: + singleValueValidator( + input, + [%t field.output_type |> ItemType.unpack], + message, + ) + ] + | SyncValidator(Ok(Optional(None))) => [%type: unit] + | AsyncValidator(_) => [%type: + Async.singleValueValidator( + input, + [%t field.output_type |> ItemType.unpack], + message, + action, + ) + ] + }, + ); + +let collection_type = + (~loc, ~validator: CollectionValidator.t, collection: Collection.t) => + Type.field( + collection.plural |> str(~loc), + switch (validator) { + | Ok(Some ()) + | Error () => [%type: + collectionValidatorWithWholeCollectionValidator( + input, + message, + [%t + Typ.constr( + Lident(collection |> CollectionPrinter.validator_type) + |> lid(~loc), + [], + ) + ], + ) + ] + | Ok(None) => [%type: + collectionValidatorWithoutWholeCollectionValidator( + [%t + Typ.constr( + Lident(collection |> CollectionPrinter.validator_type) + |> lid(~loc), + [], + ) + ], + ) + ] + }, + ); + +let field_of_collection_type = (~loc, field: Scheme.field) => + Type.field( + field.name |> str(~loc), + switch (field.validator) { + | SyncValidator(Ok(Required)) + | SyncValidator(Ok(Optional(Some(_)))) + | SyncValidator(Error ()) => [%type: + valueOfCollectionValidator( + input, + [%t field.output_type |> ItemType.unpack], + message, + ) + ] + | SyncValidator(Ok(Optional(None))) => [%type: unit] + | AsyncValidator(_) => [%type: + Async.valueOfCollectionValidator( + input, + [%t field.output_type |> ItemType.unpack], + message, + action, + ) + ] + }, + ); + let ast = (~loc, scheme: Scheme.t) => { - scheme - |> T.record_of_fields( - ~name="validators", ~loc, ~typ=(~validator, ~output_type) => - switch (validator) { - | SyncValidator(Ok(Required)) - | SyncValidator(Ok(Optional(Some(_)))) - | SyncValidator(Error ()) => [%type: - singleValueValidator( - input, - [%t output_type |> FieldType.unpack], - message, - ) - ] - | SyncValidator(Ok(Optional(None))) => [%type: unit] - | AsyncValidator(_) => [%type: - Async.singleValueValidator( - input, - [%t output_type |> FieldType.unpack], - message, - action, - ) - ] - } - ); + let main_decl = + "validators" + |> str(~loc) + |> Type.mk( + ~kind= + Ptype_record( + scheme + |> List.map((entry: Scheme.entry) => + switch (entry) { + | Field(field) => field |> field_type(~loc) + | Collection({collection, validator}) => + collection |> collection_type(~validator, ~loc) + } + ), + ), + ); + + let collections_decls = + scheme + |> List.fold_left( + (acc, entry: Scheme.entry) => + switch (entry) { + | Field(_) => acc + | Collection({collection, fields}) => [ + collection + |> CollectionPrinter.validator_type + |> str(~loc) + |> Type.mk( + ~kind= + Ptype_record( + fields |> List.map(field_of_collection_type(~loc)), + ), + ), + ...acc, + ] + }, + [], + ); + + Str.type_(~loc, Recursive, [main_decl, ...collections_decls]); }; diff --git a/lib/ppx/Meta.re b/lib/ppx/Meta.re index 5f8eff69..ed689d31 100644 --- a/lib/ppx/Meta.re +++ b/lib/ppx/Meta.re @@ -2,41 +2,7 @@ open Ast; open Ppxlib; -module Field = { - type t = - | Field(string); - - let make = (label: label_declaration) => Field(label.pld_name.txt); - - let to_camelized_string = - fun - | Field(field) => field; - - let to_capitalized_string = - fun - | Field(field) => field |> String.capitalize_ascii; - - let eq = (x1, x2) => - switch (x1, x2) { - | (Field(x1), Field(x2)) => x1 == x2 - }; - - let cmp = (x1, x2) => - switch (x1, x2) { - | (Field(x1), Field(x2)) => compare(x1, x2) - }; - - let update_action = x => "Update" ++ (x |> to_capitalized_string) ++ "Field"; - let blur_action = x => "Blur" ++ (x |> to_capitalized_string) ++ "Field"; - let apply_async_result_action = x => - "ApplyAsyncResultFor" ++ (x |> to_capitalized_string) ++ "Field"; - - let update_fn = x => "update" ++ (x |> to_capitalized_string); - let blur_fn = x => "blur" ++ (x |> to_capitalized_string); - let result_fn = x => (x |> to_camelized_string) ++ "Result"; -}; - -module FieldType = { +module ItemType = { module T: {type t;} = { type t = core_type; }; @@ -44,8 +10,6 @@ module FieldType = { type t = T.t; external make: core_type => t = "%identity"; - let make = (core_type: core_type) => core_type |> make; - external unpack: t => core_type = "%identity"; let rec eq = (t1: core_type, t2: core_type) => @@ -73,6 +37,34 @@ module FieldType = { let eq = (x1: t, x2: t) => eq(x1 |> unpack, x2 |> unpack); }; +module Collection = { + type t = { + singular: string, + plural: string, + }; +}; + +module FieldDep = { + type t = + | DepField(string) + | DepFieldOfCollection({ + collection: Collection.t, + field: string, + }); + + type unvalidated = + | UnvalidatedDepField({ + name: string, + loc: Location.t, + }) + | UnvalidatedDepFieldOfCollection({ + collection: string, + field: string, + c_loc: Location.t, + f_loc: Location.t, + }); +}; + module FieldOptionality = { type t = | OptionType @@ -116,15 +108,90 @@ module FieldValidator = { | Optional(option(unit)); }; +module CollectionValidator = { + type t = result(option(unit), unit); +}; + module Scheme = { type t = list(entry) and entry = - | Field({ - name: string, - input_type: FieldType.t, - output_type: FieldType.t, - validator: FieldValidator.t, - deps: list(Field.t), + | Field(field) + | Collection({ + collection: Collection.t, + fields: list(field), + validator: CollectionValidator.t, + input_type: ItemType.t, + output_type: ItemType.t, + }) + and field = { + name: string, + input_type: ItemType.t, + output_type: ItemType.t, + validator: FieldValidator.t, + deps: list(FieldDep.t), + }; +}; + +module InputFieldData = { + type unvalidated = { + name: string, + typ: ItemType.t, + async: option(AsyncMode.t), + deps: list(FieldDep.unvalidated), + }; + + type validated = { + name: string, + typ: ItemType.t, + async: option(AsyncMode.t), + deps: list(FieldDep.t), + }; + + let unvalidated = (~async, ~deps, field: label_declaration): unvalidated => { + name: field.pld_name.txt, + typ: field.pld_type |> ItemType.make, + async, + deps, + }; + + let validated = (~deps, field: unvalidated): validated => { + name: field.name, + typ: field.typ, + async: field.async, + deps, + }; +}; + +module InputField = { + type unvalidated = + | UnvalidatedInputField(InputFieldData.unvalidated) + | UnvalidatedInputFieldOfCollection({ + collection: Collection.t, + field: InputFieldData.unvalidated, + }); + + type validated = + | ValidatedInputField(InputFieldData.validated) + | ValidatedInputFieldOfCollection({ + collection: Collection.t, + field: InputFieldData.validated, + }); +}; + +module OutputFieldData = { + type t = { + name: string, + typ: ItemType.t, + loc: Location.t, + }; +}; + +module OutputField = { + type t = + | OutputField(OutputFieldData.t) + | OutputFieldOfCollection({ + collection: Collection.t, + field: OutputFieldData.t, }); }; @@ -163,8 +230,8 @@ module SubmissionErrorType = { }; module FieldOptionalityParser = { - let parse = (typ: FieldType.t): option(FieldOptionality.t) => - switch (typ |> FieldType.unpack) { + let parse = (typ: ItemType.t): option(FieldOptionality.t) => + switch (typ |> ItemType.unpack) { | {ptyp_desc: Ptyp_constr({txt: Lident("string")}, [])} => Some(StringType) | { @@ -186,20 +253,19 @@ module AsyncFieldParser = { | InvalidPayload(Location.t) | InvalidAsyncMode(Location.t); - let parse = (attributes: list(attribute)) => { - let async_attr = - attributes - |> List.find_opt(attr => - switch (attr) { - | {attr_name: {txt: "field.async"}} => true - | _ => false - } - ); - switch (async_attr) { - | None => Ok(None) - | Some({attr_payload: PStr([]), attr_loc}) => - Ok(Some(AsyncMode.default)) - | Some({ + let attr = field => + field.pld_type.ptyp_attributes + |> List.find_opt(attr => + switch (attr) { + | {attr_name: {txt: "field.async"}} => true + | _ => false + } + ); + + let parse = attribute => { + switch (attribute) { + | {attr_payload: PStr([]), attr_loc} => Ok(AsyncMode.default) + | { attr_payload: PStr([ { @@ -228,197 +294,841 @@ module AsyncFieldParser = { }, ]), attr_loc, - }) => + } => switch (mode) { - | "OnChange" => Ok(Some(OnChange)) - | "OnBlur" => Ok(Some(OnBlur)) + | "OnChange" => Ok(OnChange) + | "OnBlur" => Ok(OnBlur) | _ => Error(InvalidAsyncMode(loc)) } - | Some({attr_payload: PStr([{pstr_loc}])}) => + | {attr_payload: PStr([{pstr_loc}])} => Error(InvalidPayload(pstr_loc)) - | Some({attr_loc}) => Error(InvalidPayload(attr_loc)) + | {attr_loc} => Error(InvalidPayload(attr_loc)) }; }; + + let get = field => + switch (field |> attr) { + | None => Ok(None) + | Some(attr) => + switch (attr |> parse) { + | Ok(mode) => Ok(Some(mode)) + | Error(error) => Error(error) + } + }; }; module FieldDepsParser = { - type unvalidated_dep = [ | `Field(string, Location.t)]; - type error = | DepsParseError(Location.t) - | DepNotFound(unvalidated_dep) - | DepOfItself(unvalidated_dep) - | DepDuplicate(unvalidated_dep); - - let parse = (attributes: list(attribute)) => { - let deps_attr = - attributes - |> List.find_opt(attr => - switch (attr) { - | {attr_name: {txt: "field.deps"}} => true - | _ => false - } - ); - switch (deps_attr) { - | None => Ok([]) - | Some({ - attr_payload: PStr([{pstr_desc: Pstr_eval(exp, _)}]), - attr_loc, - }) => + | DepNotFound(FieldDep.unvalidated) + | DepOfItself([ | `Field(string, Location.t)]) + | DepDuplicate(FieldDep.unvalidated); + + let attr = field => + field.pld_type.ptyp_attributes + |> List.find_opt(attr => + switch (attr) { + | {attr_name: {txt: "field.deps"}} => true + | _ => false + } + ); + + let parse = + (attribute: attribute): result(list(FieldDep.unvalidated), error) => { + switch (attribute) { + | {attr_payload: PStr([{pstr_desc: Pstr_eval(exp, _)}]), attr_loc} => switch (exp) { | {pexp_desc: Pexp_ident({txt: Lident(dep), loc})} => - Ok([`Field((dep, loc))]) + Ok([UnvalidatedDepField({name: dep, loc})]) + | { + pexp_desc: + Pexp_field( + { + pexp_desc: Pexp_ident({txt: Lident(collection), loc: c_loc}), + }, + {txt: Lident(field), loc: f_loc}, + ), + } => + Ok([ + UnvalidatedDepFieldOfCollection({collection, field, c_loc, f_loc}), + ]) | {pexp_desc: Pexp_tuple(exps)} => exps |> List.fold_left( - (res, exp) => + (res: result(list(FieldDep.unvalidated), error), exp) => switch (res, exp) { - | (Error(loc), _) => Error(loc) + | (Error(error), _) => Error(error) | ( Ok(deps), {pexp_desc: Pexp_ident({txt: Lident(dep), loc})}, ) => - Ok([`Field((dep, loc)), ...deps]) + Ok([UnvalidatedDepField({name: dep, loc}), ...deps]) + | ( + Ok(deps), + { + pexp_desc: + Pexp_field( + { + pexp_desc: + Pexp_ident({ + txt: Lident(collection), + loc: c_loc, + }), + }, + {txt: Lident(field), loc: f_loc}, + ), + }, + ) => + Ok([ + UnvalidatedDepFieldOfCollection({ + collection, + field, + c_loc, + f_loc, + }), + ...deps, + ]) | (Ok(_), {pexp_loc}) => Error(DepsParseError(pexp_loc)) }, Ok([]), ) | {pexp_loc} => Error(DepsParseError(pexp_loc)) } - | Some({attr_loc}) => Error(DepsParseError(attr_loc)) + | {attr_loc} => Error(DepsParseError(attr_loc)) }; }; - let validate = - ( - fields: - list( - ( - Field.t, - FieldType.t, - option(AsyncMode.t), - list(unvalidated_dep), - ), - ), - ) => - fields - |> List.fold_left( - (res, (field: Field.t, _, _, deps)) => - switch (res) { - | Error(error) => Error(error) - | Ok(_) => - deps - |> List.fold_left( - (res, dep) => - switch (res, dep) { - | (Error(error), _) => Error(error) - | (Ok (), `Field(dep_name, loc)) => - switch ( - deps - |> List.find_all(dep' => - switch (dep') { - | `Field(dep', _) => dep' == dep_name - } - ) - |> List.length - ) { - | 0 - | 1 => - switch ( - fields - |> List.find_opt(((field: Field.t, _, _, _)) => - switch (field) { - | Field(field) => field == dep_name - } - ), - field, - ) { - | (None, _) => Error(DepNotFound(dep)) - | (Some(_), Field(field)) => - dep_name != field ? Ok() : Error(DepOfItself(dep)) - } - | _ => Error(DepDuplicate(dep)) - } - }, - Ok(), - ) - }, - Ok(), + let get = field => + switch (field |> attr) { + | None => Ok([]) + | Some(attr) => attr |> parse + }; +}; + +module FieldCollectionParser = { + type result = Pervasives.result(ok, error) + and ok = { + collection: Collection.t, + fields: list(InputFieldData.unvalidated), + input_type: ItemType.t, + } + and error = + | NotArray(Location.t) + | InvalidTypeRef(Location.t) + | RecordNotFound(Location.t) + | NotRecord(Location.t) + | InvalidAsyncField(AsyncFieldParser.error) + | InvalidFieldDeps(FieldDepsParser.error); + + let attr = (field: label_declaration) => + field.pld_type.ptyp_attributes + |> List.find_opt(attr => + switch (attr) { + | {attr_name: {txt: "field.collection"}} => true + | _ => false + } ); + + let parse = (~structure: structure, field: label_declaration): result => { + switch (field.pld_type.ptyp_desc) { + | Ptyp_constr({txt: Lident("array"), loc: arr_loc}, payload) => + switch (payload) { + | [] => Error(InvalidTypeRef(arr_loc)) + | [ + {ptyp_desc: Ptyp_constr({txt: Lident(typ_name)}, []), ptyp_loc} as input_type, + ..._, + ] => + let record_type = ref(None); + structure + |> List.iter((item: structure_item) => + switch (item) { + | {pstr_desc: Pstr_type(rec_flag, decls)} => + decls + |> List.iter((decl: type_declaration) => + switch (decl) { + | {ptype_name: {txt: name}} when name == typ_name => + switch (decl.ptype_kind) { + | Ptype_record(fields) => + record_type := Some(Ok(fields)) + | _ => + record_type := + Some(Error(NotRecord(decl.ptype_loc))) + } + | _ => () + } + ) + | _ => () + } + ); + switch (record_type^) { + | None => Error(RecordNotFound(ptyp_loc)) + | Some(Error(error)) => Error(error) + | Some(Ok(fields)) => + let fields = + fields + |> List.fold_left( + (res, field: label_declaration) => + switch (res) { + | Error(error) => Error(error) + | Ok(fields) => + switch ( + field |> AsyncFieldParser.get, + field |> FieldDepsParser.get, + ) { + | (Ok(async), Ok(deps)) => + Ok([ + field |> InputFieldData.unvalidated(~async, ~deps), + ...fields, + ]) + | (Error(error), _) => Error(InvalidAsyncField(error)) + | (_, Error(error)) => Error(InvalidFieldDeps(error)) + } + }, + Ok([]), + ); + switch (fields) { + | Ok(fields) => + Ok({ + collection: { + plural: field.pld_name.txt, + singular: typ_name, + }, + fields, + input_type: input_type |> ItemType.make, + }) + | Error(error) => Error(error) + }; + }; + | [{ptyp_loc}, ..._] => Error(InvalidTypeRef(ptyp_loc)) + } + | _ => Error(NotArray(field.pld_loc)) + }; + }; +}; + +module FieldAttributesParser = { + type result = Pervasives.result(option(ok), error) + and ok = + | Collection(FieldCollectionParser.ok) + | AsyncDeps({ + async: option(AsyncMode.t), + deps: list(FieldDep.unvalidated), + }) + and error = + | Conflict( + [ + | `AsyncWithCollection(Location.t) + | `DepsWithCollection(Location.t) + ], + ) + | InvalidCollectionField(FieldCollectionParser.error) + | InvalidAsyncField(AsyncFieldParser.error) + | InvalidFieldDeps(FieldDepsParser.error); + + let parse = (~structure: structure, field: label_declaration) => + switch ( + field |> FieldCollectionParser.attr, + field |> AsyncFieldParser.attr, + field |> FieldDepsParser.attr, + ) { + | (Some(_), None, None) => + switch (field |> FieldCollectionParser.parse(~structure)) { + | Ok(collection) => Ok(Some(Collection(collection))) + | Error(error) => Error(InvalidCollectionField(error)) + } + | (None, Some(async_attr), Some(deps_attr)) => + switch ( + async_attr |> AsyncFieldParser.parse, + deps_attr |> FieldDepsParser.parse, + ) { + | (Ok(async), Ok(deps)) => + Ok(Some(AsyncDeps({async: Some(async), deps}))) + | (Error(error), _) => Error(InvalidAsyncField(error)) + | (_, Error(error)) => Error(InvalidFieldDeps(error)) + } + | (None, Some(async_attr), None) => + switch (async_attr |> AsyncFieldParser.parse) { + | Ok(async) => Ok(Some(AsyncDeps({async: Some(async), deps: []}))) + | Error(error) => Error(InvalidAsyncField(error)) + } + | (None, None, Some(deps_attr)) => + switch (deps_attr |> FieldDepsParser.parse) { + | Ok(deps) => Ok(Some(AsyncDeps({async: None, deps}))) + | Error(error) => Error(InvalidFieldDeps(error)) + } + | (None, None, None) => Ok(None) + | (Some(_), Some({attr_loc}), _) => + Error(Conflict(`AsyncWithCollection(attr_loc))) + | (Some(_), _, Some({attr_loc})) => + Error(Conflict(`DepsWithCollection(attr_loc))) + }; }; module InputTypeParser = { type result = Pervasives.result(ok, error) and ok = { - fields, + entries: list(unvalidated_entry), type_declaration: InputType.t, } - and fields = - list( - ( - Field.t, - FieldType.t, - option(AsyncMode.t), - list(FieldDepsParser.unvalidated_dep), - ), - ) + and unvalidated_entry = + | UnvalidatedInputField(InputFieldData.unvalidated) + | UnvalidatedInputCollection({ + collection: Collection.t, + fields: list(InputFieldData.unvalidated), + input_type: ItemType.t, + }) + and validated_entry = + | ValidatedInputField(InputFieldData.validated) + | ValidatedInputCollection({ + collection: Collection.t, + fields: list(InputFieldData.validated), + input_type: ItemType.t, + }) and error = | NotFound | NotRecord(Location.t) - | InvalidAsyncField(AsyncFieldParser.error) - | InvalidFieldDeps(FieldDepsParser.error); + | InvalidAttributes(FieldAttributesParser.error); - let parse = (~decl, ~rec_flag, ~loc, fields) => { - let fields = + let parse = (~decl, ~structure, ~loc, fields) => { + let entries = List.fold_right( (field, res) => - switch ( - res, - field.pld_type.ptyp_attributes |> AsyncFieldParser.parse, - field.pld_type.ptyp_attributes |> FieldDepsParser.parse, - ) { - | (Ok(fields), Ok(async), Ok(deps)) => + switch (res, field |> FieldAttributesParser.parse(~structure)) { + | ( + Ok(entries), + Ok(Some(Collection({collection, fields, input_type}))), + ) => Ok([ - ( - field |> Field.make, - field.pld_type |> FieldType.make, - async, - deps, + UnvalidatedInputCollection({collection, fields, input_type}), + ...entries, + ]) + | (Ok(entries), Ok(Some(AsyncDeps({async, deps})))) => + Ok([ + UnvalidatedInputField( + field |> InputFieldData.unvalidated(~async, ~deps), ), - ...fields, + ...entries, ]) - | (Error(error), _, _) => Error(error) - | (_, Error(error), _) => Error(InvalidAsyncField(error)) - | (_, _, Error(error)) => Error(InvalidFieldDeps(error)) + | (Ok(entries), Ok(None)) => + Ok([ + UnvalidatedInputField( + field |> InputFieldData.unvalidated(~async=None, ~deps=[]), + ), + ...entries, + ]) + | (Error(error), _) => Error(error) + | (_, Error(error)) => Error(InvalidAttributes(error)) }, fields, Ok([]), ); - switch (fields) { + switch (entries) { | Error(error) => Error(error) - | Ok(fields) => Ok({fields, type_declaration: decl |> InputType.make}) + | Ok(entries) => Ok({entries, type_declaration: decl |> InputType.make}) }; }; - let in_deps_of = (fields: fields, field: Field.t) => - fields - |> List.find_opt(((field', _, _, deps)) => - if (field |> Field.eq(field')) { - false; - } else { - switch ( - deps - |> List.find_opt(dep => - switch (dep, field) { - | (`Field(dep, _), Field(field)) => dep == field - } + let validate = + (unvalidated_entries: list(unvalidated_entry)) + : Pervasives.result(list(validated_entry), FieldDepsParser.error) => { + let dup = (deps: list(FieldDep.unvalidated), dep: FieldDep.unvalidated) => + switch ( + deps + |> List.find_all((dep': FieldDep.unvalidated) => + switch (dep, dep') { + | ( + UnvalidatedDepField({name: dep}), + UnvalidatedDepField({name: dep'}), + ) => + dep == dep + | ( + UnvalidatedDepFieldOfCollection({collection, field}), + UnvalidatedDepFieldOfCollection({ + collection: collection', + field: field', + }), + ) => + collection == collection' && field == field' + | (UnvalidatedDepField(_), UnvalidatedDepFieldOfCollection(_)) + | (UnvalidatedDepFieldOfCollection(_), UnvalidatedDepField(_)) => + false + } + ) + |> List.length + ) { + | 0 + | 1 => None + | _ => Some() + }; + + unvalidated_entries + |> List.fold_left( + ( + res: + Pervasives.result(list(validated_entry), FieldDepsParser.error), + unvalidated_entry: unvalidated_entry, + ) => + switch (res, unvalidated_entry) { + | (Error(error), _) => Error(error) + | (Ok(validated_entries), UnvalidatedInputField(field)) => + let deps = + field.deps + |> List.fold_left( + ( + res: + Pervasives.result( + list(FieldDep.t), + FieldDepsParser.error, + ), + dep, + ) => + switch (res) { + | Error(error) => Error(error) + | Ok(validated_deps) => + switch (dep |> dup(field.deps)) { + | Some () => Error(FieldDepsParser.DepDuplicate(dep)) + | None => + switch ( + unvalidated_entries + |> List.fold_left( + ( + res: + option( + Pervasives.result( + FieldDep.t, + FieldDepsParser.error, + ), + ), + entry, + ) => + switch (res, dep, entry) { + | (Some(_) as res, _, _) => res + | ( + None, + UnvalidatedDepField(dep'), + UnvalidatedInputField(field'), + ) => + if (field.name == field'.name + && field'.name == dep'.name) { + Some( + Error( + FieldDepsParser.DepOfItself( + `Field((dep'.name, dep'.loc)), + ), + ), + ); + } else if (field'.name == dep'.name) { + Some(Ok(DepField(dep'.name))); + } else { + None; + } + | ( + None, + UnvalidatedDepFieldOfCollection(dep'), + UnvalidatedInputCollection(entry'), + ) => + if (dep'.collection + != entry'.collection.singular) { + None; + } else { + switch ( + entry'.fields + |> List.find_opt( + ( + field: InputFieldData.unvalidated, + ) => + dep'.field == field.name + ) + ) { + | None => + Some( + Error( + FieldDepsParser.DepNotFound(dep), + ), + ) + | Some(field) => + Some( + Ok( + DepFieldOfCollection({ + collection: entry'.collection, + field: field.name, + }), + ), + ) + }; + } + | ( + None, + UnvalidatedDepField(_), + UnvalidatedInputCollection(_), + ) + | ( + None, + UnvalidatedDepFieldOfCollection(_), + UnvalidatedInputField(_), + ) => + None + }, + None, + ) + ) { + | None => Error(FieldDepsParser.DepNotFound(dep)) + | Some(Error(error)) => Error(error) + | Some(Ok(dep_entry)) => + Ok([dep_entry, ...validated_deps]) + } + } + }, + Ok([]), + ); + switch (deps) { + | Error(error) => Error(error) + | Ok(deps) => + Ok([ + ValidatedInputField( + field |> InputFieldData.validated(~deps), + ), + ...validated_entries, + ]) + }; + | ( + Ok(validated_entries), + UnvalidatedInputCollection({ + collection, + fields: unvalidated_fields, + input_type, + }), + ) => + let validated_fields = + unvalidated_fields + |> List.fold_left( + ( + res: + Pervasives.result( + list(InputFieldData.validated), + FieldDepsParser.error, + ), + field: InputFieldData.unvalidated, + ) => + switch (res) { + | Error(error) => Error(error) + | Ok(validated_fields) => + let deps = + field.deps + |> List.fold_left( + ( + res: + Pervasives.result( + list(FieldDep.t), + FieldDepsParser.error, + ), + dep, + ) => + switch (res) { + | Error(error) => Error(error) + | Ok(validated_deps) => + switch (dep |> dup(field.deps)) { + | Some () => + Error(FieldDepsParser.DepDuplicate(dep)) + | None => + switch ( + unvalidated_entries + |> List.fold_left( + ( + res: + option( + Pervasives.result( + FieldDep.t, + FieldDepsParser.error, + ), + ), + entry, + ) => + switch (res, dep, entry) { + | (Some(_) as res, _, _) => res + | ( + None, + UnvalidatedDepField(dep'), + UnvalidatedInputField( + field', + ), + ) => + if (field'.name == dep'.name) { + Some( + Ok(DepField(dep'.name)), + ); + } else { + None; + } + | ( + None, + UnvalidatedDepFieldOfCollection( + dep', + ), + UnvalidatedInputCollection( + entry', + ), + ) => + if (dep'.collection + != entry'.collection. + singular) { + None; + } else { + switch ( + entry'.fields + |> List.fold_left( + ( + res: + option( + Pervasives.result( + FieldDep.t, + FieldDepsParser.error, + ), + ), + field: InputFieldData.unvalidated, + ) => + switch (res) { + | Some(_) => res + | None => + if (dep'.field + == field.name) { + Some( + Ok( + DepFieldOfCollection({ + collection: + entry'. + collection, + field: + field.name, + }), + ), + ); + } else { + None; + } + }, + None, + ) + ) { + | None => + Some( + Error( + FieldDepsParser.DepNotFound( + dep, + ), + ), + ) + | Some(Error(error)) => + Some(Error(error)) + | Some(Ok(dep)) => + Some(Ok(dep)) + }; + } + | ( + None, + UnvalidatedDepField(_), + UnvalidatedInputCollection( + _ + ), + ) + | ( + None, + UnvalidatedDepFieldOfCollection( + _ + ), + UnvalidatedInputField(_), + ) => + None + }, + None, + ) + ) { + | None => + Error( + FieldDepsParser.DepNotFound(dep), + ) + | Some(Error(error)) => Error(error) + | Some(Ok(dep_entry)) => + Ok([dep_entry, ...validated_deps]) + } + } + }, + Ok([]), + ); + switch (deps) { + | Error(error) => Error(error) + | Ok(deps) => + Ok([ + field |> InputFieldData.validated(~deps), + ...validated_fields, + ]) + }; + }, + Ok([]), + ); + switch (validated_fields) { + | Error(error) => Error(error) + | Ok(validated_fields) => + Ok([ + ValidatedInputCollection({ + collection, + fields: validated_fields, + input_type, + }), + ...validated_entries, + ]) + }; + }, + Ok([]), + ); + }; + + let in_deps_of = + (entries: list(validated_entry), field: InputField.validated) + : option(InputField.validated) => { + entries + |> List.fold_left( + (res, entry: validated_entry) => + switch (res, field, entry) { + | (Some(_), _, _) => res + | ( + None, + ValidatedInputField(subject_field), + ValidatedInputField(entry_field), + ) => + entry_field.deps + |> List.fold_left( + (res: option(InputField.validated), dep: FieldDep.t) => + switch (res, dep) { + | (Some(_), _) => res + | (None, DepField(dep)) => + if (dep == subject_field.name) { + Some(ValidatedInputField(entry_field)); + } else { + None; + } + | (None, DepFieldOfCollection(_)) => None + }, + None, ) - ) { - | Some(_) => true - | None => false - }; - } + | ( + None, + ValidatedInputField(subject_field), + ValidatedInputCollection({ + collection: entry_collection, + fields: entry_fields, + }), + ) => + entry_fields + |> List.fold_left( + ( + res: option(InputField.validated), + entry_field: InputFieldData.validated, + ) => + entry_field.deps + |> List.fold_left( + (res: option(InputField.validated), dep: FieldDep.t) => + switch (res, dep) { + | (Some(_), _) => res + | (None, DepField(dep)) => + if (dep == subject_field.name) { + Some( + ValidatedInputFieldOfCollection({ + collection: entry_collection, + field: entry_field, + }), + ); + } else { + None; + } + | (None, DepFieldOfCollection(_)) => None + }, + None, + ), + None, + ) + | ( + None, + ValidatedInputFieldOfCollection({ + collection: subject_collection, + field: subject_field, + }), + ValidatedInputField(entry_field), + ) => + entry_field.deps + |> List.fold_left( + (res: option(InputField.validated), dep: FieldDep.t) => + switch (res, dep) { + | (Some(_), _) => res + | (None, DepField(dep)) => None + | ( + None, + DepFieldOfCollection({ + collection: dep_collection, + field: dep_field, + }), + ) => + if (dep_collection.singular + == subject_collection.singular + && dep_field == subject_field.name) { + Some(ValidatedInputField(entry_field)); + } else { + None; + } + }, + None, + ) + | ( + None, + ValidatedInputFieldOfCollection({ + collection: subject_collection, + field: subject_field, + }), + ValidatedInputCollection({ + collection: entry_collection, + fields: entry_fields, + }), + ) => + entry_fields + |> List.fold_left( + ( + res: option(InputField.validated), + entry_field: InputFieldData.validated, + ) => + entry_field.deps + |> List.fold_left( + (res: option(InputField.validated), dep: FieldDep.t) => + switch (res, dep) { + | (Some(_), _) => res + | (None, DepField(dep)) => None + | ( + None, + DepFieldOfCollection({ + collection: dep_collection, + field: dep_field, + }), + ) => + if (subject_collection.singular + == dep_collection.singular + && subject_field.name == dep_field) { + Some( + ValidatedInputFieldOfCollection({ + collection: entry_collection, + field: entry_field, + }), + ); + } else { + None; + } + }, + None, + ), + None, + ) + }, + None, ); + }; }; module OutputTypeParser = { @@ -427,34 +1137,185 @@ module OutputTypeParser = { | NotProvided | AliasOfInput | Record({ - fields: list((Field.t, FieldType.t, Location.t)), + entries: list(entry), loc: Location.t, }) + and entry = + | OutputField(OutputFieldData.t) + | OutputCollection({ + collection: Collection.t, + fields: list(OutputFieldData.t), + output_type: ItemType.t, + }) and error = + | InputNotAvailable(Location.t) | NotRecord(Location.t) | BadTypeAlias({ alias: string, loc: Location.t, - }); + }) + | OutputCollectionNotFound({ + input_collection: Collection.t, + loc: Location.t, + }) + | InvalidCollection(collection_error) + and collection_error = + | InvalidCollectionTypeRef(Location.t) + | CollectionTypeNotRecord(Location.t) + | CollectionTypeNotFound(Location.t) + | CollectionOutputNotArray(Location.t); - let parse_as_record = (~decl, ~loc, fields) => - Record({ - loc, - fields: + let flatten = (entries: list(entry)): list(OutputField.t) => + List.fold_right( + (entry, acc) => + switch (entry) { + | OutputField(field) => [OutputField.OutputField(field), ...acc] + | OutputCollection({collection, fields}) => + List.fold_right( + (field, acc) => + [ + OutputField.OutputFieldOfCollection({collection, field}), + ...acc, + ], + fields, + acc, + ) + }, + entries, + [], + ); + + let parse = + ( + ~structure, + ~input_collections: list(Collection.t), + ~loc, + fields: list(label_declaration), + ) => + switch (input_collections) { + | [] => + Ok( + Record({ + loc, + entries: + List.fold_right( + (field, acc) => + [ + OutputField({ + name: field.pld_name.txt, + typ: field.pld_type |> ItemType.make, + loc: field.pld_loc, + }), + ...acc, + ], + fields, + [], + ), + }), + ) + | _ => + let entries = List.fold_right( (field, acc) => - [ - ( - field |> Field.make, - field.pld_type |> FieldType.make, - field.pld_loc, - ), - ...acc, - ], + switch (acc) { + | Error(error) => Error(error) + | Ok(entries) => + let field_name = field.pld_name.txt; + switch ( + input_collections + |> List.find_opt((collection: Collection.t) => + collection.plural == field_name + ) + ) { + | None => + Ok([ + OutputField({ + name: field_name, + typ: field.pld_type |> ItemType.make, + loc: field.pld_loc, + }), + ...entries, + ]) + | Some(input_collection) => + switch (field.pld_type.ptyp_desc) { + | Ptyp_constr({txt: Lident("array"), loc: arr_loc}, payload) => + switch (payload) { + | [] => Error(InvalidCollectionTypeRef(arr_loc)) + | [ + { + ptyp_desc: Ptyp_constr({txt: Lident(type_name)}, []), + ptyp_loc, + } as output_type, + ..._, + ] => + let record_type = ref(None); + structure + |> List.iter((item: structure_item) => + switch (item) { + | {pstr_desc: Pstr_type(rec_flag, decls)} => + decls + |> List.iter((decl: type_declaration) => + switch (decl) { + | {ptype_name: {txt: name}} + when name == type_name => + switch (decl.ptype_kind) { + | Ptype_record(fields) => + record_type := Some(Ok(fields)) + | _ => + record_type := + Some( + Error( + CollectionTypeNotRecord( + decl.ptype_loc, + ), + ), + ) + } + | _ => () + } + ) + | _ => () + } + ); + switch (record_type^) { + | None => Error(CollectionTypeNotFound(ptyp_loc)) + | Some(Error(error)) => Error(error) + | Some(Ok(fields)) => + Ok([ + OutputCollection({ + collection: { + plural: field_name, + singular: type_name, + }, + fields: + fields + |> List.map((field: label_declaration) => + OutputFieldData.{ + name: field.pld_name.txt, + typ: field.pld_type |> ItemType.make, + loc: field.pld_loc, + } + ), + output_type: output_type |> ItemType.make, + }), + ...entries, + ]) + }; + | [{ptyp_loc}, ..._] => + Error(InvalidCollectionTypeRef(ptyp_loc)) + } + | _ => Error(CollectionOutputNotArray(field.pld_loc)) + } + }; + }, fields, - [], - ), - }); + Ok([]), + ); + switch (entries) { + | Ok(entries) => Ok(Record({loc, entries})) + | Error(error) => Error(InvalidCollection(error)) + }; + }; }; module DebounceIntervalParser = { @@ -477,11 +1338,11 @@ module ValidatorsRecordParser = { | ValidatorError( [ | `BadRequiredValidator( - Field.t, + InputField.validated, [ | `Some(Location.t) | `None(Location.t)], [ - | `IncludedInDeps(Field.t) - | `DifferentIO(FieldType.t, FieldType.t) + | `IncludedInDeps(InputField.validated) + | `DifferentIO(ItemType.t, ItemType.t) ], ) ], @@ -586,72 +1447,145 @@ module ValidatorsRecordParser = { ); }; - let find = (field: Field.t, validators: ValidatorsRecord.fields) => + let find_field = + (field: InputField.validated, validators: ValidatorsRecord.fields) => validators - |> List.find_opt(validator => - switch (field, validator) { - | (Field(field), ({txt: Lident(field')}, _)) => field == field' - | (Field(_), ({txt: _}, _)) => false - } + |> List.fold_left( + (res, validator) => + switch (res, field, validator) { + | (Some(_), _, _) => res + | (None, ValidatedInputField(field), ({txt: Lident(key)}, _)) => + field.name == key ? Some(validator) : None + | ( + None, + ValidatedInputFieldOfCollection({collection, field}), + ( + {txt: Lident(key)}, + {pexp_desc: Pexp_record(fields, None)}, + ), + ) => + if (collection.plural == key) { + fields + |> List.fold_left( + (res, entry) => + switch (res, entry) { + | (Some(_), _) => res + | ( + None, + ( + {txt: Lident("fields")}, + {pexp_desc: Pexp_record(fields, None)}, + ), + ) => + fields + |> List.find_opt(entry => + switch (entry) { + | ({txt: Lident(key)}, _) => key == field.name + | _ => false + } + ) + | (None, _) => None + }, + None, + ); + } else { + None; + } + | ( + None, + ValidatedInputFieldOfCollection({collection, field}), + ({txt: _}, _), + ) => + None + | (None, ValidatedInputField(_), ({txt: _}, _)) => None + }, + None, ); - let required = (field: Field.t, validators: ValidatorsRecord.fields) => { - switch (field, validators |> find(field)) { - | (Field(field), Some((_, {pexp_desc: Pexp_record(_)}))) => Ok() - | ( - Field(field), - Some(( - _, - { - pexp_desc: - Pexp_construct( - {txt: Lident("Some")}, - Some({pexp_desc: Pexp_record(_)}), - ), - pexp_loc, - }, - )), - ) => + let find_collection = + (collection: Collection.t, validators: ValidatorsRecord.fields) => + validators + |> List.fold_left( + (res, validator) => + switch (res, validator) { + | (Some(_), _) => res + | ( + None, + ( + {txt: Lident(key)}, + {pexp_desc: Pexp_record(fields, None)}, + ), + ) + when collection.plural == key => + fields + |> List.fold_left( + (res, entry) => + switch (res, entry) { + | (Some(_), _) => res + | (None, ({txt: Lident("collection")}, exp)) => + Some(exp) + | (None, _) => None + }, + None, + ) + | (None, ({txt: _}, _)) => None + }, + None, + ); + + let required = + (field: InputField.validated, validators: ValidatorsRecord.fields) => { + switch (validators |> find_field(field)) { + | Some((_, {pexp_desc: Pexp_record(_)})) => Ok() + | Some(( + _, + { + pexp_desc: + Pexp_construct( + {txt: Lident("Some")}, + Some({pexp_desc: Pexp_record(_)}), + ), + pexp_loc, + }, + )) => Error(`Some(pexp_loc)) - | ( - Field(field), - Some(( - _, - { - pexp_desc: Pexp_construct({txt: Lident("None")}, None), - pexp_loc, - }, - )), - ) => + | Some(( + _, + {pexp_desc: Pexp_construct({txt: Lident("None")}, None), pexp_loc}, + )) => Error(`None(pexp_loc)) - // Don't know what it is, let compiler do the job - | (Field(field), Some(_)) => Error(`BadValue) - // Validator doesn't exist, delegating to compiler - | (Field(field), None) => Error(`NotFound) + | Some(_) => Error(`BadValue) + | None => Error(`NotFound) }; }; - let optional = (field: Field.t, validators: ValidatorsRecord.fields) => { - switch (field, validators |> find(field)) { - | (Field(field), Some((_, {pexp_desc: Pexp_record(_)}))) => Ok(Some()) - | ( - Field(field), - Some(( - _, - {pexp_desc: Pexp_construct({txt: Lident("None")}, None)}, - )), - ) => + let optional = + (field: InputField.validated, validators: ValidatorsRecord.fields) => { + switch (validators |> find_field(field)) { + | Some((_, {pexp_desc: Pexp_record(_)})) => Ok(Some()) + | Some((_, {pexp_desc: Pexp_construct({txt: Lident("None")}, None)})) => Ok(None) - | (Field(field), Some(_)) => Error(`BadValue) - | (Field(field), None) => Error(`NotFound) + | Some(_) => Error(`BadValue) + | None => Error(`NotFound) }; }; + + let collection = + (collection: Collection.t, validators: ValidatorsRecord.fields) => + switch (validators |> find_collection(collection)) { + | Some({pexp_desc: Pexp_fun(_)}) => Ok(Some()) + | Some({pexp_desc: Pexp_construct({txt: Lident("None")}, None)}) => + Ok(None) + | Some(_) => Error(`BadValue) + | None => Error(`NotFound) + }; }; module Metadata = { type t = { scheme: Scheme.t, async: bool, // meh, it should be variant: Sync(_) | Async(_) + collections: list(Collection.t), output_type: OutputTypeParser.ok, validators_record: ValidatorsRecord.t, message_type: option(unit), @@ -666,13 +1600,13 @@ module Metadata = { | IOMismatch(io_mismatch) and io_mismatch = | InputFieldsNotInOutput({ - fields: list(Field.t), + fields: list(InputField.validated), loc: Location.t, }) - | OutputFieldsNotInInput({fields: list((Field.t, Location.t))}) + | OutputFieldsNotInInput({fields: list(OutputField.t)}) | Both({ - input_fields_not_in_output: list(Field.t), - output_fields_not_in_input: list((Field.t, Location.t)), + input_fields_not_in_output: list(InputField.validated), + output_fields_not_in_input: list(OutputField.t), loc: Location.t, }); @@ -706,7 +1640,7 @@ module Metadata = { fields |> InputTypeParser.parse( ~decl, - ~rec_flag, + ~structure, ~loc=ptype_loc, ), ) @@ -719,15 +1653,38 @@ module Metadata = { ptype_name: {txt: "output"}, ptype_kind: Ptype_record(fields), ptype_loc, - } as decl => - output_parsing_result := - Ok( + } => + switch (input_parsing_result^) { + | None => + output_parsing_result := + Error(InputNotAvailable(ptype_loc)) + | Some(Ok({entries})) => + output_parsing_result := fields - |> OutputTypeParser.parse_as_record( - ~decl, + |> OutputTypeParser.parse( + ~structure, ~loc=ptype_loc, - ), - ) + ~input_collections= + entries + |> List.fold_left( + ( + acc, + entry: InputTypeParser.unvalidated_entry, + ) => + switch (entry) { + | UnvalidatedInputField(_) => acc + | UnvalidatedInputCollection({ + collection, + }) => [ + collection, + ...acc, + ] + }, + [], + ), + ) + | Some(Error(_)) => () + } | { ptype_name: {txt: "output"}, ptype_kind: Ptype_abstract, @@ -802,261 +1759,566 @@ module Metadata = { Ok(output_result), Some(Ok(validators_record)), ) => - switch (input_data.fields |> FieldDepsParser.validate) { - | Error(error) => Error(InputTypeParseError(InvalidFieldDeps(error))) - | Ok () => + switch (input_data.entries |> InputTypeParser.validate) { + | Error(error) => + Error( + InputTypeParseError(InvalidAttributes(InvalidFieldDeps(error))), + ) + | Ok(validated_input_entries) => let scheme: result(Scheme.t, error) = switch (output_result) { | NotProvided | AliasOfInput => - input_data.fields + let validator = + ( + ~field: InputField.validated, + ~entries: list(InputTypeParser.validated_entry), + ~validators_record: ValidatorsRecord.t, + ~async_mode: option(AsyncMode.t), + ~output_type: ItemType.t, + ) + : result(FieldValidator.t, error) => + switch (async_mode) { + | None => + switch (field |> InputTypeParser.in_deps_of(entries)) { + | Some(in_deps_of_entry) => + switch ( + validators_record.fields + |> ValidatorsRecordParser.required(field) + ) { + | Ok () => Ok(SyncValidator(Ok(Required))) + | Error(`NotFound | `BadValue) => + // Proceeding here since compiler + // would give more insightful error message + Ok(SyncValidator(Error())) + | Error(`Some(_) as reason | `None(_) as reason) => + // In this case we can give more insights (hopefully) + // on how to fix this error + Error( + ValidatorsRecordParseError( + ValidatorError( + `BadRequiredValidator(( + field, + reason, + `IncludedInDeps(in_deps_of_entry), + )), + ), + ), + ) + } + | None => + switch ( + validators_record.fields + |> ValidatorsRecordParser.optional(field) + ) { + | Ok(res) => Ok(SyncValidator(Ok(Optional(res)))) + | Error(`NotFound | `BadValue) => + // Proceeding here since compiler + // would give more insightful error message + Ok(SyncValidator(Error())) + } + } + | Some(mode) => + Ok( + AsyncValidator({ + mode, + optionality: output_type |> FieldOptionalityParser.parse, + }), + ) + }; + + validated_input_entries |> List.fold_left( - (res, (field, input_type, async, deps)) => { - switch (res) { - | Error(error) => Error(error) - | Ok(scheme) => - let validator: result(FieldValidator.t, error) = - switch (async) { - | None => - switch ( - field - |> InputTypeParser.in_deps_of(input_data.fields) - ) { - | Some((in_deps_of_field, _, _, _)) => - switch ( - validators_record.fields - |> ValidatorsRecordParser.required(field) - ) { - | Ok () => Ok(SyncValidator(Ok(Required))) - | Error(`NotFound | `BadValue) => - // Proceeding here since compiler - // would give more insightful error message - Ok(SyncValidator(Error())) - | Error(`Some(_) as reason | `None(_) as reason) => - // In this case we can give more insights (hopefully) - // on how to fix this error - Error( - ValidatorsRecordParseError( - ValidatorError( - `BadRequiredValidator(( - field, - reason, - `IncludedInDeps(in_deps_of_field), - )), - ), - ), - ) - } - | None => - switch ( - validators_record.fields - |> ValidatorsRecordParser.optional(field) - ) { - | Ok(res) => - Ok(SyncValidator(Ok(Optional(res)))) - | Error(`NotFound | `BadValue) => - // Proceeding here since compiler - // would give more insightful error message - Ok(SyncValidator(Error())) - } - } - | Some(mode) => - Ok( - AsyncValidator({ - mode, - optionality: - input_type |> FieldOptionalityParser.parse, - }), - ) - }; - switch (field, validator) { - | (Field(field), Ok(validator)) => + (res, entry: InputTypeParser.validated_entry) => { + switch (res, entry) { + | (Error(error), _) => Error(error) + | (Ok(scheme), ValidatedInputField(field)) => + let validator = + validator( + ~field=ValidatedInputField(field), + ~entries=validated_input_entries, + ~validators_record, + ~async_mode=field.async, + ~output_type=field.typ, + ); + switch (validator) { + | Ok(validator) => Ok([ Scheme.Field({ - name: field, + name: field.name, + input_type: field.typ, + output_type: field.typ, + validator, + deps: field.deps, + }), + ...scheme, + ]) + | Error(error) => Error(error) + }; + + | ( + Ok(scheme), + ValidatedInputCollection({ + collection, + fields, + input_type, + }), + ) => + let fields = + fields + |> List.fold_left( + (res, field) => + switch (res) { + | Error(error) => Error(error) + | Ok(fields) => + let validator = + validator( + ~field= + ValidatedInputFieldOfCollection({ + collection, + field, + }), + ~entries=validated_input_entries, + ~validators_record, + ~async_mode=field.async, + ~output_type=field.typ, + ); + switch (validator) { + | Ok(validator) => + Ok([ + Scheme.{ + name: field.name, + input_type: field.typ, + output_type: field.typ, + validator, + deps: field.deps, + }, + ...fields, + ]) + | Error(error) => Error(error) + }; + }, + Ok([]), + ); + switch (fields) { + | Error(error) => Error(error) + | Ok(fields) => + Ok([ + Scheme.Collection({ + collection, + fields, input_type, output_type: input_type, - validator, - deps: - deps - |> List.map( - fun - | `Field(dep, _) => Field.Field(dep), - ), + validator: + switch ( + validators_record.fields + |> ValidatorsRecordParser.collection( + collection, + ) + ) { + | Ok(res) => Ok(res) + | Error(_) => Error() + }, }), ...scheme, ]) - | (_, Error(error)) => Error(error) }; } }, Ok([]), - ) - | Record({fields: output_fields, loc: output_loc}) => + ); + | Record({entries: output_entries, loc: output_loc}) => + let validator = + ( + ~input_field: InputField.validated, + ~input_field_data: InputFieldData.validated, + ~output_field_data: OutputFieldData.t, + ~input_entries: list(InputTypeParser.validated_entry), + ~validators_record: ValidatorsRecord.t, + ) + : result(FieldValidator.t, error) => + switch (input_field_data.async) { + | None => + switch ( + input_field |> InputTypeParser.in_deps_of(input_entries) + ) { + | Some(in_deps_of_field) => + switch ( + validators_record.fields + |> ValidatorsRecordParser.required(input_field) + ) { + | Ok () => Ok(SyncValidator(Ok(Required))) + | Error(`NotFound | `BadValue) => + // Proceeding here since compiler + // would give more insightful error message + Ok(SyncValidator(Error())) + | Error(`Some(_) as reason | `None(_) as reason) => + // In this case we can give more insights (hopefully) + // on how to fix this error + Error( + ValidatorsRecordParseError( + ValidatorError( + `BadRequiredValidator(( + input_field, + reason, + `IncludedInDeps(in_deps_of_field), + )), + ), + ), + ) + } + | None => + if (ItemType.eq(input_field_data.typ, output_field_data.typ)) { + switch ( + validators_record.fields + |> ValidatorsRecordParser.optional(input_field) + ) { + | Ok(res) => Ok(SyncValidator(Ok(Optional(res)))) + | Error(`NotFound | `BadValue) => + // Proceeding here since compiler + // would give more insightful error message + Ok(SyncValidator(Error())) + }; + } else { + switch ( + validators_record.fields + |> ValidatorsRecordParser.required(input_field) + ) { + | Ok () => Ok(SyncValidator(Ok(Required))) + | Error(`NotFound | `BadValue) => + // Proceeding here since compiler + // would give more insightful error message + Ok(SyncValidator(Error())) + | Error(`Some(_) as reason | `None(_) as reason) => + // In this case we can give more insights (hopefully) + // on how to fix this error + Error( + ValidatorsRecordParseError( + ValidatorError( + `BadRequiredValidator(( + input_field, + reason, + `DifferentIO(( + input_field_data.typ, + output_field_data.typ, + )), + )), + ), + ), + ) + }; + } + } + | Some(mode) => + Ok( + AsyncValidator({ + mode, + optionality: + output_field_data.typ |> FieldOptionalityParser.parse, + }), + ) + }; + let ( - matched_fields, + result, input_fields_not_in_output, output_fields_not_in_input, ) = List.fold_right( ( + input_entry: InputTypeParser.validated_entry, ( - input_field, - input_field_type, - input_field_async_mode, - input_field_deps, - ), - ( - matched_fields, - input_fields_not_in_output, - output_fields_not_in_input, + result: result(Scheme.t, error), + input_fields_not_in_output: list(InputField.validated), + output_fields_not_in_input: list(OutputField.t), ), - ) => { - let output_field = - output_fields - |> List.find_opt(((output_field, _, _)) => - input_field |> Field.eq(output_field) - ); - switch (matched_fields, output_field) { - | (_, None) => ( - matched_fields, - [input_field, ...input_fields_not_in_output], - output_fields_not_in_input, - ) - | ( - Error(error), - Some((output_field, output_field_type, _)), - ) => ( - Error(error), - input_fields_not_in_output, - output_fields_not_in_input - |> List.filter(((output_field, _, _)) => - !(input_field |> Field.eq(output_field)) - ), - ) + ) => + switch (input_entry) { + | ValidatedInputField(input_field_data) => + let output_field_data = + output_entries + |> List.fold_left( + (res, output_entry: OutputTypeParser.entry) => + switch (res, output_entry) { + | (Some(_), _) => res + | (None, OutputField(output_field_data)) => + input_field_data.name == output_field_data.name + ? Some(output_field_data) : None + | (None, OutputCollection(_)) => None + }, + None, + ); + switch (result, output_field_data) { + | (_, None) => ( + result, + [ + ValidatedInputField(input_field_data), + ...input_fields_not_in_output, + ], + output_fields_not_in_input, + ) - | (Ok(scheme), Some((output_field, output_field_type, _))) => - let validator: result(FieldValidator.t, error) = - switch (input_field_async_mode) { - | None => - switch ( - input_field - |> InputTypeParser.in_deps_of(input_data.fields) - ) { - | Some((in_deps_of_field, _, _, _)) => - switch ( - validators_record.fields - |> ValidatorsRecordParser.required(input_field) - ) { - | Ok () => Ok(SyncValidator(Ok(Required))) - | Error(`NotFound | `BadValue) => - // Proceeding here since compiler - // would give more insightful error message - Ok(SyncValidator(Error())) - | Error(`Some(_) as reason | `None(_) as reason) => - // In this case we can give more insights (hopefully) - // on how to fix this error - Error( - ValidatorsRecordParseError( - ValidatorError( - `BadRequiredValidator(( - input_field, - reason, - `IncludedInDeps(in_deps_of_field), - )), - ), - ), - ) - } - | None => - if (FieldType.eq( - input_field_type, - output_field_type, - )) { - switch ( - validators_record.fields - |> ValidatorsRecordParser.optional(input_field) - ) { - | Ok(res) => - Ok(SyncValidator(Ok(Optional(res)))) - | Error(`NotFound | `BadValue) => - // Proceeding here since compiler - // would give more insightful error message - Ok(SyncValidator(Error())) - }; - } else { - switch ( - validators_record.fields - |> ValidatorsRecordParser.required(input_field) - ) { - | Ok () => Ok(SyncValidator(Ok(Required))) - | Error(`NotFound | `BadValue) => - // Proceeding here since compiler - // would give more insightful error message - Ok(SyncValidator(Error())) - | Error(`Some(_) as reason | `None(_) as reason) => - // In this case we can give more insights (hopefully) - // on how to fix this error - Error( - ValidatorsRecordParseError( - ValidatorError( - `BadRequiredValidator(( - input_field, - reason, - `DifferentIO(( - input_field_type, - output_field_type, - )), - )), - ), - ), + | (Error(error), Some(output_field_data)) => ( + Error(error), + input_fields_not_in_output, + output_fields_not_in_input + |> List.filter((output_field: OutputField.t) => + switch (output_field) { + | OutputField(output_field_data) => + output_field_data.name != input_field_data.name + | OutputFieldOfCollection(_) => true + } + ), + ) + + | (Ok(scheme), Some(output_field_data)) => + let validator = + validator( + ~input_field=ValidatedInputField(input_field_data), + ~input_field_data, + ~output_field_data, + ~input_entries=validated_input_entries, + ~validators_record, + ); + ( + switch (validator) { + | Error(error) => Error(error) + | Ok(validator) => + Ok([ + Scheme.Field({ + name: input_field_data.name, + input_type: input_field_data.typ, + output_type: output_field_data.typ, + validator, + deps: input_field_data.deps, + }), + ...scheme, + ]) + }, + input_fields_not_in_output, + output_fields_not_in_input + |> List.filter((output_field: OutputField.t) => + switch (output_field) { + | OutputField(output_field_data) => + output_field_data.name != input_field_data.name + | OutputFieldOfCollection(_) => true + } + ), + ); + }; + + | ValidatedInputCollection({ + collection: input_collection, + fields: input_fields, + input_type: input_collection_type, + }) => + let output_collection = + output_entries + |> List.fold_left( + (res, output_entry: OutputTypeParser.entry) => + switch (res, output_entry) { + | (Some(_), _) => res + | (None, OutputField(_)) => res + | ( + None, + OutputCollection({ + collection: output_collection, + fields, + output_type, + }), + ) => + if (output_collection.plural + == input_collection.plural) { + Some(( + output_collection, + fields, + output_type, + )); + } else { + None; + } + }, + None, + ); + switch (output_collection) { + | None => ( + Error( + OutputTypeParseError( + OutputCollectionNotFound({ + input_collection, + loc: output_loc, + }), + ), + ), + input_fields + |> List.fold_left( + (acc: list(InputField.validated), field) => + [ + ValidatedInputFieldOfCollection({ + collection: input_collection, + field, + }), + ...acc, + ], + input_fields_not_in_output, + ), + output_fields_not_in_input, + ) + | Some((output_collection, output_fields, output_type)) => + let ( + fields, + input_fields_not_in_output, + output_fields_not_in_input, + ) = + List.fold_right( + ( + input_field_data: InputFieldData.validated, + ( + res: result(list(Scheme.field), error), + input_fields_not_in_output: + list(InputField.validated), + output_fields_not_in_input: list(OutputField.t), + ), + ) => { + let output_field_data = + output_fields + |> List.find_opt( + (output_field_data: OutputFieldData.t) => + output_field_data.name + == input_field_data.name + ); + + switch (res, output_field_data) { + | (_, None) => ( + res, + [ + ValidatedInputFieldOfCollection({ + collection: input_collection, + field: input_field_data, + }), + ...input_fields_not_in_output, + ], + output_fields_not_in_input, + ) + + | (Error(error), Some(output_field_data)) => ( + Error(error), + input_fields_not_in_output, + output_fields_not_in_input + |> List.filter((output_field: OutputField.t) => + switch (output_field) { + | OutputField(_) => true + | OutputFieldOfCollection({ + collection, + field, + }) => + !( + input_collection.plural + == collection.plural + && output_field_data.name + == field.name + ) + } + ), ) + | (Ok(fields), Some(output_field_data)) => + let validator = + validator( + ~input_field= + ValidatedInputFieldOfCollection({ + collection: input_collection, + field: input_field_data, + }), + ~input_field_data, + ~output_field_data, + ~input_entries=validated_input_entries, + ~validators_record, + ); + ( + switch (validator) { + | Error(error) => Error(error) + | Ok(validator) => + Ok([ + { + name: input_field_data.name, + input_type: input_field_data.typ, + output_type: output_field_data.typ, + validator, + deps: input_field_data.deps, + }, + ...fields, + ]) + }, + input_fields_not_in_output, + output_fields_not_in_input + |> List.filter((output_field: OutputField.t) => + switch (output_field) { + | OutputField(_) => true + | OutputFieldOfCollection({ + collection, + field, + }) => + !( + input_collection.plural + == collection.plural + && output_field_data.name + == field.name + ) + } + ), + ); }; - } - } - | Some(mode) => - Ok( - AsyncValidator({ - mode, - optionality: - output_field_type |> FieldOptionalityParser.parse, - }), + }, + input_fields, + ( + Ok([]), + input_fields_not_in_output, + output_fields_not_in_input, + ), + ); + + switch (result, fields) { + | (Error(error), _) => ( + result, + input_fields_not_in_output, + output_fields_not_in_input, + ) + | (Ok(_), Error(error)) => ( + Error(error), + input_fields_not_in_output, + output_fields_not_in_input, + ) + | (Ok(scheme), Ok(fields)) => ( + Ok([ + Scheme.Collection({ + collection: input_collection, + fields, + input_type: input_collection_type, + output_type, + validator: + switch ( + validators_record.fields + |> ValidatorsRecordParser.collection( + input_collection, + ) + ) { + | Ok(res) => Ok(res) + | Error(_) => Error() + }, + }), + ...scheme, + ]), + input_fields_not_in_output, + output_fields_not_in_input, ) }; - - ( - switch (input_field, validator) { - | (_, Error(error)) => Error(error) - | (Field(field), Ok(validator)) => - Ok([ - Scheme.Field({ - name: field, - input_type: input_field_type, - output_type: output_field_type, - validator, - deps: - input_field_deps - |> List.map( - fun - | `Field(dep, _) => Field.Field(dep), - ), - }), - ...scheme, - ]) - }, - input_fields_not_in_output, - output_fields_not_in_input - |> List.filter(((output_field, _, _)) => - !(input_field |> Field.eq(output_field)) - ), - ); - }; - }, - input_data.fields, - (Ok([]), [], output_fields), + }; + }, + validated_input_entries, + (Ok([]), [], output_entries |> OutputTypeParser.flatten), ); switch (input_fields_not_in_output, output_fields_not_in_input) { - | ([], []) => matched_fields + | ([], []) => result | (input_fields_not_in_output, []) => Error( IOMismatch( @@ -1066,13 +2328,11 @@ module Metadata = { }), ), ) - | ([], output_fields_not_in_input) => + | ([], output_entries_not_in_input) => Error( IOMismatch( OutputFieldsNotInInput({ - fields: - output_fields_not_in_input - |> List.map(((field, _, loc)) => (field, loc)), + fields: output_fields_not_in_input, }), ), ) @@ -1081,9 +2341,7 @@ module Metadata = { IOMismatch( Both({ input_fields_not_in_output, - output_fields_not_in_input: - output_fields_not_in_input - |> List.map(((field, _, loc)) => (field, loc)), + output_fields_not_in_input, loc: output_loc, }), ), @@ -1105,8 +2363,26 @@ module Metadata = { switch (entry) { | Field({validator: AsyncValidator(_)}) => true | Field({validator: SyncValidator(_)}) => false + | Collection({fields}) => + fields + |> List.exists((field: Scheme.field) => + switch (field) { + | {validator: AsyncValidator(_)} => true + | {validator: SyncValidator(_)} => false + } + ) } ), + collections: + scheme + |> List.fold_left( + (acc, entry: Scheme.entry) => + switch (entry) { + | Field(_) => acc + | Collection({collection}) => [collection, ...acc] + }, + [], + ), output_type: output_result, validators_record, message_type: message_type^, diff --git a/lib/ppx/Ppx.re b/lib/ppx/Ppx.re index 4c7ddc58..bceedf23 100644 --- a/lib/ppx/Ppx.re +++ b/lib/ppx/Ppx.re @@ -1,8 +1,13 @@ // TODO: [Public Api] Change `updateField` siganture so it accepts `input => input` instead of `input` +// TODO: [Public Api] Change `form.fieldResult()` from function to just value, since all these functions are called anyway // TODO: [Meta] In some cases (records?) order of items is reversed. -// TODO: [Collections] Collections: `items: [@field.collection] array(item)` -// TODO: [Collections] Whole collection validation -// TODO: [Collections] Add/remove items from collections +// TODO: [Collections] Whole collection validation: +// - validate on changes in structure of the collection (add/remove etc) +// - validate on whole form validation +// - add result fn to interface +// TODO: [Collections] On add/remove collection entries, fields must be revalidated // TODO: [Collections] Reorder items in collections +// TODO: [General] Prolly makes sense to move functions from Formality module to own modules to reduce bundle size +// I.e. if user doesn't use async stuff or collections, those wouldn't get into the final bundle (unless tree shaking works these days) "formality" |> Ppxlib.Driver.register_transformation(~extensions=[Form.ext]); diff --git a/lib/ppx/Printer.re b/lib/ppx/Printer.re new file mode 100644 index 00000000..d4b8f0ab --- /dev/null +++ b/lib/ppx/Printer.re @@ -0,0 +1,74 @@ +open Meta; + +module FieldPrinter = { + let update_action = (~field) => + "Update" ++ (field |> String.capitalize_ascii) ++ "Field"; + + let blur_action = (~field) => + "Blur" ++ (field |> String.capitalize_ascii) ++ "Field"; + + let apply_async_result_action = (~field) => + "ApplyAsyncResultFor" ++ (field |> String.capitalize_ascii) ++ "Field"; + + let update_fn = (~field) => "update" ++ (field |> String.capitalize_ascii); + + let blur_fn = (~field) => "blur" ++ (field |> String.capitalize_ascii); + + let result_fn = (~field) => field ++ "Result"; +}; + +module FieldOfCollectionPrinter = { + let update_action = (~field, ~collection: Collection.t) => + "Update" + ++ (collection.singular |> String.capitalize_ascii) + ++ (field |> String.capitalize_ascii) + ++ "Field"; + + let blur_action = (~field, ~collection: Collection.t) => + "Blur" + ++ (collection.singular |> String.capitalize_ascii) + ++ (field |> String.capitalize_ascii) + ++ "Field"; + + let apply_async_result_action = (~field, ~collection: Collection.t) => + "ApplyAsyncResultFor" + ++ (collection.singular |> String.capitalize_ascii) + ++ (field |> String.capitalize_ascii) + ++ "Field"; + + let update_fn = (~field, ~collection: Collection.t) => + "update" + ++ (collection.singular |> String.capitalize_ascii) + ++ (field |> String.capitalize_ascii); + + let blur_fn = (~field, ~collection: Collection.t) => + "blur" + ++ (collection.singular |> String.capitalize_ascii) + ++ (field |> String.capitalize_ascii); + + let result_fn = (~field, ~collection: Collection.t) => + collection.singular ++ (field |> String.capitalize_ascii) ++ "Result"; +}; + +module CollectionPrinter = { + let fields_statuses_type = (collection: Collection.t) => + collection.singular ++ "FieldsStatuses"; + + let validator_type = (collection: Collection.t) => + collection.plural ++ "Validators"; + + let add_action = (collection: Collection.t) => + "Add" ++ (collection.singular |> String.capitalize_ascii) ++ "Entry"; + + let remove_action = (collection: Collection.t) => + "Remove" ++ (collection.singular |> String.capitalize_ascii) ++ "Entry"; + + let add_fn = (collection: Collection.t) => + "add" ++ (collection.singular |> String.capitalize_ascii); + + let remove_fn = (collection: Collection.t) => + "remove" ++ (collection.singular |> String.capitalize_ascii); + + let result_value = (collection: Collection.t) => + collection.plural ++ "Result"; +}; diff --git a/lib/src/Formality.re b/lib/src/Formality.re index 4de1544c..2c804a43 100644 --- a/lib/src/Formality.re +++ b/lib/src/Formality.re @@ -16,6 +16,8 @@ type fieldStatus('outputValue, 'message) = | Pristine | Dirty(result('outputValue, 'message), visibility); +type collectionStatus('message) = result(unit, 'message); + type formStatus('submissionError) = | Editing | Submitting(option('submissionError)) @@ -42,8 +44,17 @@ type singleValueValidator('input, 'outputValue, 'message) = { validate: 'input => result('outputValue, 'message), }; -type collectionValidator('input, 'message, 'fieldsValidators) = { - collection: option('input => result(unit, 'message)), +type collectionValidatorWithWholeCollectionValidator( + 'input, + 'message, + 'fieldsValidators, +) = { + collection: 'input => result(unit, 'message), + fields: 'fieldsValidators, +}; + +type collectionValidatorWithoutWholeCollectionValidator('fieldsValidators) = { + collection: unit, fields: 'fieldsValidators, }; @@ -99,7 +110,32 @@ let validateFieldOnChangeWithValidator = }; }; -let validateFieldDependencyOnChange = +let validateFieldOfCollectionOnChangeWithValidator = + ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus('outputValue, 'message), + ~submissionStatus: submissionStatus, + ~validator: valueOfCollectionValidator('input, 'outputValue, 'message), + ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, + ) + : 'statuses => { + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index), Shown)->setStatus + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch (validator.validate(input, ~at=index)) { + | Ok(_) as result => Dirty(result, Shown)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus + }; +}; + +let validateDependentFieldOnChange = ( ~input: 'input, ~fieldStatus: fieldStatus('outputValue, 'message), @@ -115,6 +151,23 @@ let validateFieldDependencyOnChange = }; }; +let validateDependentFieldOfCollectionOnChange = + ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus('outputValue, 'message), + ~validator: valueOfCollectionValidator('input, 'outputValue, 'message), + ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, + ) + : option('statuses) => { + switch (fieldStatus) { + | Pristine + | Dirty(_, Hidden) => None + | Dirty(_, Shown) => + Dirty(validator.validate(input, ~at=index), Shown)->setStatus->Some + }; +}; + let validateFieldOnBlurWithoutValidator = ( ~fieldInput: 'outputValue, @@ -150,6 +203,31 @@ let validateFieldOnBlurWithValidator = }; }; +let validateFieldOfCollectionOnBlurWithValidator = + ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus('outputValue, 'message), + ~validator: valueOfCollectionValidator('input, 'outputValue, 'message), + ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, + ) + : option('statuses) => { + switch (fieldStatus) { + | Dirty(_, Shown) => None + | Pristine + | Dirty(_, Hidden) => + switch (validator.strategy) { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + Dirty(validator.validate(input, ~at=index), Shown)->setStatus->Some + } + }; +}; + module Async = { type fieldStatus('outputValue, 'message) = | Pristine @@ -170,7 +248,7 @@ module Async = { type valueOfCollectionValidator('input, 'outputValue, 'message, 'action) = { strategy, validate: ('input, ~at: index) => result('outputValue, 'message), - validateAsync: (~value: 'outputValue, ~dispatch: 'action => unit) => unit, + validateAsync: (('outputValue, index, 'action => unit)) => unit, eq: ('outputValue, 'outputValue) => bool, }; @@ -188,6 +266,14 @@ module Async = { ->Js.Promise.(then_(res => res->andThen->resolve, _)) ->ignore; + type formValidationResult('output, 'fieldsStatuses) = + | Valid({ + output: 'output, + fieldsStatuses: 'fieldsStatuses, + }) + | Invalid({fieldsStatuses: 'fieldsStatuses}) + | Validating({fieldsStatuses: 'fieldsStatuses}); + let exposeFieldResult = (fieldStatus: fieldStatus('outputValue, 'message)) : option(exposedFieldStatus('outputValue, 'message)) => @@ -225,6 +311,39 @@ module Async = { }; }; + let validateFieldOfCollectionOnChangeInOnBlurMode = + ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus('outputValue, 'message), + ~submissionStatus: submissionStatus, + ~validator: + valueOfCollectionValidator( + 'input, + 'outputValue, + 'message, + 'action, + ), + ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, + ) + : 'statuses => { + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch (validator.validate(input, ~at=index)) { + | Ok(_) as result => Dirty(result, Hidden)->setStatus + | Error(_) as result => Dirty(result, Shown)->setStatus + } + | ( + OnFirstSuccess | OnFirstSuccessOrFirstBlur | OnFirstBlur | OnSubmit, + _, + NeverSubmitted, + ) => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus + }; + }; + let validateFieldOfOptionTypeOnChangeInOnBlurMode = ( ~input: 'input, @@ -255,6 +374,42 @@ module Async = { }; }; + let validateFieldOfCollectionOfOptionTypeOnChangeInOnBlurMode = + ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus('outputValue, 'message), + ~submissionStatus: submissionStatus, + ~validator: + valueOfCollectionValidator( + 'input, + 'outputValue, + 'message, + 'action, + ), + ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, + ) + : 'statuses => { + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch (validator.validate(input, ~at=index)) { + | Ok(Some(_)) as result => Dirty(result, Hidden)->setStatus + | Ok(None) as result + | Error(_) as result => Dirty(result, Shown)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch (validator.validate(input, ~at=index)) { + | Ok(None) as result => Dirty(result, Shown)->setStatus + | Ok(Some(_)) as result + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus + }; + }; + let validateFieldOfStringTypeOnChangeInOnBlurMode = ( ~input: 'input, @@ -284,6 +439,37 @@ module Async = { }; }; + let validateFieldOfCollectionOfStringTypeOnChangeInOnBlurMode = + ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus(string, 'message), + ~submissionStatus: submissionStatus, + ~validator: + valueOfCollectionValidator('input, string, 'message, 'action), + ~setStatus: fieldStatus(string, 'message) => 'statuses, + ) + : 'statuses => { + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch (validator.validate(input, ~at=index)) { + | Ok("") as result + | Error(_) as result => Dirty(result, Shown)->setStatus + | Ok(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch (validator.validate(input, ~at=index)) { + | Ok("") as result => Dirty(result, Shown)->setStatus + | Ok(_) as result + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus + }; + }; + let validateFieldOfOptionStringTypeOnChangeInOnBlurMode = ( ~input: 'input, @@ -316,6 +502,44 @@ module Async = { }; }; + let validateFieldOfCollectionOfOptionStringTypeOnChangeInOnBlurMode = + ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus(option(string), 'message), + ~submissionStatus: submissionStatus, + ~validator: + valueOfCollectionValidator( + 'input, + option(string), + 'message, + 'action, + ), + ~setStatus: fieldStatus(option(string), 'message) => 'statuses, + ) + : 'statuses => { + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch (validator.validate(input, ~at=index)) { + | Ok(Some("")) as result + | Ok(None) as result + | Error(_) as result => Dirty(result, Shown)->setStatus + | Ok(Some(_)) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch (validator.validate(input, ~at=index)) { + | Ok(Some("")) as result + | Ok(None) as result => Dirty(result, Shown)->setStatus + | Ok(Some(_)) as result + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus + }; + }; + let validateFieldOnChangeInOnChangeMode = ( ~input: 'input, @@ -344,6 +568,40 @@ module Async = { }; }; + let validateFieldOfCollectionOnChangeInOnChangeMode = + ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus('outputValue, 'message), + ~submissionStatus: submissionStatus, + ~validator: + valueOfCollectionValidator( + 'input, + 'outputValue, + 'message, + 'action, + ), + ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, + ) + : 'statuses => { + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch (validator.validate(input, ~at=index)) { + | Ok(x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Shown)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch (validator.validate(input, ~at=index)) { + | Ok(x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus + }; + }; + let validateFieldOfOptionTypeOnChangeInOnChangeMode = ( ~input: 'input, @@ -374,6 +632,42 @@ module Async = { }; }; + let validateFieldOfCollectionOfOptionTypeOnChangeInOnChangeMode = + ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus('outputValue, 'message), + ~submissionStatus: submissionStatus, + ~validator: + valueOfCollectionValidator( + 'input, + 'outputValue, + 'message, + 'action, + ), + ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, + ) + : 'statuses => { + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch (validator.validate(input, ~at=index)) { + | Ok(Some(_) as x) => Validating(x)->setStatus + | Ok(None) as result + | Error(_) as result => Dirty(result, Shown)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch (validator.validate(input, ~at=index)) { + | Ok(Some(_) as x) => Validating(x)->setStatus + | Ok(None) as result => Dirty(result, Shown)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus + }; + }; + let validateFieldOfStringTypeOnChangeInOnChangeMode = ( ~input: 'input, @@ -403,6 +697,37 @@ module Async = { }; }; + let validateFieldOfCollectionOfStringTypeOnChangeInOnChangeMode = + ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus(string, 'message), + ~submissionStatus: submissionStatus, + ~validator: + valueOfCollectionValidator('input, string, 'message, 'action), + ~setStatus: fieldStatus(string, 'message) => 'statuses, + ) + : 'statuses => { + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch (validator.validate(input, ~at=index)) { + | Ok("") as result + | Error(_) as result => Dirty(result, Shown)->setStatus + | Ok(x) => Validating(x)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch (validator.validate(input, ~at=index)) { + | Ok("") as result => Dirty(result, Shown)->setStatus + | Ok(x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus + }; + }; + let validateFieldOfOptionStringTypeOnChangeInOnChangeMode = ( ~input: 'input, @@ -435,7 +760,45 @@ module Async = { }; }; - let validateFieldDependencyOnChange = + let validateFieldOfCollectionOfOptionStringTypeOnChangeInOnChangeMode = + ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus(option(string), 'message), + ~submissionStatus: submissionStatus, + ~validator: + valueOfCollectionValidator( + 'input, + option(string), + 'message, + 'action, + ), + ~setStatus: fieldStatus(option(string), 'message) => 'statuses, + ) + : 'statuses => { + switch (validator.strategy, fieldStatus, submissionStatus) { + | (_, Dirty(_, Shown), _) + | (_, _, AttemptedToSubmit) + | (OnFirstChange, _, NeverSubmitted) => + switch (validator.validate(input, ~at=index)) { + | Ok(Some("")) as result + | Ok(None) as result + | Error(_) as result => Dirty(result, Shown)->setStatus + | Ok(Some(_) as x) => Validating(x)->setStatus + } + | (OnFirstSuccess | OnFirstSuccessOrFirstBlur, _, NeverSubmitted) => + switch (validator.validate(input, ~at=index)) { + | Ok(Some("")) as result + | Ok(None) as result => Dirty(result, Shown)->setStatus + | Ok(Some(_) as x) => Validating(x)->setStatus + | Error(_) as result => Dirty(result, Hidden)->setStatus + } + | (OnFirstBlur | OnSubmit, _, NeverSubmitted) => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus + }; + }; + + let validateDependentFieldOnChange = ( ~input: 'input, ~fieldStatus: fieldStatus('outputValue, 'message), @@ -453,6 +816,30 @@ module Async = { }; }; + let validateDependentFieldOfCollectionOnChange = + ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus('outputValue, 'message), + ~validator: + valueOfCollectionValidator( + 'input, + 'outputValue, + 'message, + 'action, + ), + ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, + ) + : option('statuses) => { + switch (fieldStatus) { + | Pristine + | Validating(_) + | Dirty(_, Hidden) => None + | Dirty(_, Shown) => + Dirty(validator.validate(input, ~at=index), Shown)->setStatus->Some + }; + }; + let validateFieldOnBlur = ( ~input: 'input, @@ -481,6 +868,41 @@ module Async = { }; }; + let validateFieldOfCollectionOnBlur = + ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus('outputValue, 'message), + ~validator: + valueOfCollectionValidator( + 'input, + 'outputValue, + 'message, + 'action, + ), + ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, + ) + : option('statuses) => { + switch (fieldStatus) { + | Validating(_) + | Dirty(_, Shown) => None + | Pristine + | Dirty(_, Hidden) => + switch (validator.strategy) { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch (validator.validate(input, ~at=index)) { + | Ok(x) => Validating(x)->setStatus->Some + | Error(_) as result => Dirty(result, Shown)->setStatus->Some + } + } + }; + }; + let validateFieldOfOptionTypeOnBlur = ( ~input: 'input, @@ -510,6 +932,42 @@ module Async = { }; }; + let validateFieldOfCollectionOfOptionTypeOnBlur = + ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus('outputValue, 'message), + ~validator: + valueOfCollectionValidator( + 'input, + 'outputValue, + 'message, + 'action, + ), + ~setStatus: fieldStatus('outputValue, 'message) => 'statuses, + ) + : option('statuses) => { + switch (fieldStatus) { + | Validating(_) + | Dirty(_, Shown) => None + | Pristine + | Dirty(_, Hidden) => + switch (validator.strategy) { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch (validator.validate(input, ~at=index)) { + | Ok(Some(_) as x) => Validating(x)->setStatus->Some + | Ok(None) as result + | Error(_) as result => Dirty(result, Shown)->setStatus->Some + } + } + }; + }; + let validateFieldOfStringTypeOnBlur = ( ~input: 'input, @@ -538,6 +996,37 @@ module Async = { }; }; + let validateFieldOfCollectionOfStringTypeOnBlur = + ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus(string, 'message), + ~validator: + valueOfCollectionValidator('input, string, 'message, 'action), + ~setStatus: fieldStatus(string, 'message) => 'statuses, + ) + : option('statuses) => { + switch (fieldStatus) { + | Validating(_) + | Dirty(_, Shown) => None + | Pristine + | Dirty(_, Hidden) => + switch (validator.strategy) { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch (validator.validate(input, ~at=index)) { + | Ok("") as result + | Error(_) as result => Dirty(result, Shown)->setStatus->Some + | Ok(x) => Validating(x)->setStatus->Some + } + } + }; + }; + let validateFieldOfOptionStringTypeOnBlur = ( ~input: 'input, @@ -567,4 +1056,41 @@ module Async = { } }; }; + + let validateFieldOfCollectionOfOptionStringTypeOnBlur = + ( + ~input: 'input, + ~index: index, + ~fieldStatus: fieldStatus(option(string), 'message), + ~validator: + valueOfCollectionValidator( + 'input, + option(string), + 'message, + 'action, + ), + ~setStatus: fieldStatus(option(string), 'message) => 'statuses, + ) + : option('statuses) => { + switch (fieldStatus) { + | Validating(_) + | Dirty(_, Shown) => None + | Pristine + | Dirty(_, Hidden) => + switch (validator.strategy) { + | OnFirstChange + | OnFirstSuccess + | OnSubmit => + Dirty(validator.validate(input, ~at=index), Hidden)->setStatus->Some + | OnFirstBlur + | OnFirstSuccessOrFirstBlur => + switch (validator.validate(input, ~at=index)) { + | Ok(Some("")) as result + | Ok(None) as result + | Error(_) as result => Dirty(result, Shown)->setStatus->Some + | Ok(Some(_) as x) => Validating(x)->setStatus->Some + } + } + }; + }; };