diff --git a/src/Form.elm b/src/Form.elm index eaf105f..55535e1 100644 --- a/src/Form.elm +++ b/src/Form.elm @@ -9,7 +9,7 @@ Documentation for the original TypeScript library can be found here: String -> Schema -> Maybe UiSchema -> Form -init options id schema uiSchema = +init : Settings -> UI.DefOptions -> String -> Schema -> Maybe UiSchema -> Form +init settings options id schema uiSchema = { schema = schema , uiSchema = Maybe.withDefaultLazy (\() -> generateUiSchema schema) uiSchema , uiSchemaIsGenerated = uiSchema == Nothing - , state = Form.State.initState id (defaultValue schema) (validate schema) + , state = Form.State.initState id (defaultValue schema) (validate settings schema) , defaultOptions = options + , settings = settings } @@ -121,7 +122,7 @@ setSchema schema form = else form.uiSchema - , state = Form.State.initState form.state.formId (defaultValue schema) (validate schema) + , state = Form.State.initState form.state.formId (defaultValue schema) (validate form.settings schema) } @@ -145,7 +146,7 @@ update msg form = { form | state = Form.State.updateState - (validate form.schema) + (validate form.settings form.schema) msg form.state } @@ -170,7 +171,7 @@ The value is present only if form validation passes with no errors. -} getSubmitValue : Form -> Maybe Value getSubmitValue form = - validate form.schema form.state.value + validate form.settings form.schema form.state.value |> Result.toMaybe diff --git a/src/Form/Error.elm b/src/Form/Error.elm index 78f1617..c56e085 100644 --- a/src/Form/Error.elm +++ b/src/Form/Error.elm @@ -22,6 +22,7 @@ type ErrorValue = Empty | InvalidString | InvalidFormat TextFormat + | InvalidCustomFormat String | InvalidInt | InvalidFloat | InvalidBool diff --git a/src/Form/State.elm b/src/Form/State.elm index 0fc6a20..2f92e22 100644 --- a/src/Form/State.elm +++ b/src/Form/State.elm @@ -2,6 +2,7 @@ module Form.State exposing ( Form , FormState , Msg(..) + , Settings , ValidateWidgets(..) , getErrorAt , initState @@ -27,6 +28,7 @@ type alias Form = , uiSchemaIsGenerated : Bool , state : FormState , defaultOptions : UI.DefOptions + , settings : Settings } @@ -40,6 +42,16 @@ type alias FormState = } +{-| Settings for forms initialization: + + - `customFormats` where keys are the accepted custom formats (e.g., personal-number-se\_bank\_id) and values are validation functions for the formats. + +-} +type alias Settings = + { customFormats : Dict String (String -> Result String String) + } + + {-| Controls which widgets should show validation errors. All - all widgets should show validation errors. Used after a form submission attempt. diff --git a/src/Form/Validation.elm b/src/Form/Validation.elm index 3d098e5..540001a 100644 --- a/src/Form/Validation.elm +++ b/src/Form/Validation.elm @@ -1,8 +1,10 @@ module Form.Validation exposing (validate) -import Form.Error as Error exposing (ErrorValue(..)) +import Dict +import Form.Error as Error exposing (ErrorValue(..), TextFormat(..)) import Form.Normalization exposing (normalizeValue) import Form.Regex +import Form.State exposing (Settings) import Json.Decode as Decode exposing (Value) import Json.Encode as Encode import Json.Schema.Definitions @@ -19,17 +21,17 @@ import Set import Validation exposing (Validation, error) -validate : Schema -> Value -> Validation Value -validate schema rawValue = +validate : Settings -> Schema -> Value -> Validation Value +validate settings schema rawValue = let value = normalizeValue rawValue in - Validation.voidRight value <| validateSchema schema value + Validation.voidRight value <| validateSchema settings schema value -validateSchema : Schema -> Value -> Validation Value -validateSchema schema rawValue = +validateSchema : Settings -> Schema -> Value -> Validation Value +validateSchema settings schema rawValue = let value = normalizeValue rawValue @@ -44,17 +46,17 @@ validateSchema schema rawValue = Validation.fail (error <| Unimplemented "Boolean schemas are not implemented.") ObjectSchema objectSchema -> - validateSubSchema objectSchema value + validateSubSchema settings objectSchema value -validateSubSchema : SubSchema -> Value -> Validation Value -validateSubSchema schema = +validateSubSchema : Settings -> SubSchema -> Value -> Validation Value +validateSubSchema settings schema = let typeValidations : Value -> Validation Value typeValidations = case schema.type_ of SingleType type_ -> - validateSingleType schema type_ + validateSingleType settings schema type_ AnyType -> Validation.succeed @@ -62,11 +64,11 @@ validateSubSchema schema = NullableType type_ -> Validation.oneOf [ \v -> Result.map (always Encode.null) <| validateNull v - , validateSingleType schema type_ + , validateSingleType settings schema type_ ] UnionType types -> - Validation.oneOf <| List.map (\type_ -> validateSingleType schema type_) types + Validation.oneOf <| List.map (\type_ -> validateSingleType settings schema type_) types in Validation.validateAll [ Validation.whenJust schema.const validateConst @@ -75,8 +77,8 @@ validateSubSchema schema = ] -validateSingleType : SubSchema -> SingleType -> Value -> Validation Value -validateSingleType schema type_ value = +validateSingleType : Settings -> SubSchema -> SingleType -> Value -> Validation Value +validateSingleType settings schema type_ value = case type_ of ObjectType -> let @@ -99,7 +101,7 @@ validateSingleType schema type_ value = Ok Encode.null ( Just val, _ ) -> - validateSchema propSchema val + validateSchema settings propSchema val in Validation.validateAll (List.map (\( key, propSchema ) _ -> validateKey key propSchema) propList) value @@ -113,7 +115,7 @@ validateSingleType schema type_ value = Result.map Encode.bool <| validateBool value StringType -> - Result.map Encode.string <| validateString schema value + Result.map Encode.string <| validateString settings schema value NullType -> Result.map (always Encode.null) <| validateNull value @@ -122,8 +124,8 @@ validateSingleType schema type_ value = Err <| error (Error.Unimplemented "array") -validateString : SubSchema -> Value -> Validation String -validateString schema v = +validateString : Settings -> SubSchema -> Value -> Validation String +validateString settings schema v = case Decode.decodeValue Decode.string v of Err _ -> Err <| error Error.InvalidString @@ -133,31 +135,37 @@ validateString schema v = [ Validation.whenJust schema.minLength validateMinLength , Validation.whenJust schema.maxLength validateMaxLength , Validation.whenJust schema.pattern validatePattern -- TODO: check specs if this is correct - , Validation.whenJust schema.format validateFormat -- TODO: check specs if this is correct + , Validation.whenJust schema.format (validateFormat settings) -- TODO: check specs if this is correct ] s -validateFormat : String -> String -> Validation String -validateFormat format v = +validateFormat : Settings -> String -> String -> Validation String +validateFormat settings format value = case format of "date-time" -> - validateRegex Form.Regex.dateTime Error.DateTime v + validateRegex Form.Regex.dateTime Error.DateTime value "date" -> - validateRegex Form.Regex.date Error.Date v + validateRegex Form.Regex.date Error.Date value "time" -> - validateRegex Form.Regex.time Error.Time v + validateRegex Form.Regex.time Error.Time value "email" -> - validateRegex Form.Regex.email Error.Email v + validateRegex Form.Regex.email Error.Email value "phone" -> - validateRegex Form.Regex.phone Error.Phone v + validateRegex Form.Regex.phone Error.Phone value - _ -> - Validation.succeed v + customFormat -> + let + customValidation = + Dict.get customFormat settings.customFormats + |> Maybe.map (\validation -> validation value) + |> Maybe.withDefault (Result.Ok value) + in + Result.mapError (\err -> error (Error.InvalidCustomFormat err)) customValidation validatePattern : String -> String -> Validation String diff --git a/src/Form/Widget/Generate.elm b/src/Form/Widget/Generate.elm index 350acf3..626f297 100644 --- a/src/Form/Widget/Generate.elm +++ b/src/Form/Widget/Generate.elm @@ -38,7 +38,7 @@ goWidget form uiState = let ruleEffect : Maybe Rule.AppliedEffect ruleEffect = - Rule.computeRule form.state.value (UI.getRule uiState.uiSchema) + Rule.computeRule form.settings form.state.value (UI.getRule uiState.uiSchema) newUiState = { uiState | disabled = ruleEffect == Just Rule.Disabled } @@ -116,7 +116,7 @@ categorizationWidget form uiState categorization = Maybe.withDefault 0 <| Dict.get uiState.uiPath form.state.categoryFocus categoryButton ix cat = - if Rule.computeRule form.state.value cat.rule == Just Rule.Hidden then + if Rule.computeRule form.settings form.state.value cat.rule == Just Rule.Hidden then Nothing else diff --git a/src/Form/Widget/View.elm b/src/Form/Widget/View.elm index 7b09d56..b6c42ea 100644 --- a/src/Form/Widget/View.elm +++ b/src/Form/Widget/View.elm @@ -332,6 +332,9 @@ errorString error = InvalidFormat _ -> "not the correct format" + InvalidCustomFormat _ -> + "not the correct format" + InvalidInt -> "not a valid integer" diff --git a/src/UiSchema/Rule.elm b/src/UiSchema/Rule.elm index fdd05d6..f46741b 100644 --- a/src/UiSchema/Rule.elm +++ b/src/UiSchema/Rule.elm @@ -1,5 +1,6 @@ module UiSchema.Rule exposing (AppliedEffect(..), computeRule) +import Form.State exposing (Settings) import Form.Validation exposing (validate) import Json.Decode exposing (Value) import Json.Pointer as Pointer @@ -12,8 +13,8 @@ type AppliedEffect | Disabled -computeRule : Value -> Maybe UI.Rule -> Maybe AppliedEffect -computeRule formValue mRule = +computeRule : Settings -> Value -> Maybe UI.Rule -> Maybe AppliedEffect +computeRule settings formValue mRule = let condition rule = case Pointer.pointedValue rule.condition.scope formValue of @@ -21,7 +22,7 @@ computeRule formValue mRule = False Just v -> - Validation.isOk <| validate rule.condition.schema v + Validation.isOk <| validate settings rule.condition.schema v go rule = case ( rule.effect, condition rule ) of