From 3eb7cb9f635c80778a0105b3209d04f4e1e7c926 Mon Sep 17 00:00:00 2001 From: James Randall Date: Mon, 19 Aug 2019 08:59:05 +0100 Subject: [PATCH] Added explicit support for discriminated unions --- README.md | 62 +++++++++++++++++++ samples/Demo/Program.fs | 44 +++++++++++++ .../AccidentalFish.FSharp.Validation.fsproj | 2 +- .../Validation.fs | 54 ++++++++++++++++ 4 files changed, 161 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index 39096c8..1924ed8 100644 --- a/README.md +++ b/README.md @@ -289,6 +289,67 @@ let validator = createValidatorFor() { } ``` +## Discriminated Unions + +### Single Case + +Its common to use single case unions for wrapping simple types and preventing, for example, misassignment. Consider the following model: + +```fsharp +type CustomerId = CustomerId of string + +type Customer = + { + customerId: CustomerId + } +``` + +We might want to ensure the customer ID value is not empty and has a maximum length. One way to accomplish that would be to use a function (see Collections above) but the framework also has a validate command that supports unwrapping the value as shown below: + +```fsharp +let unwrapCustomerId (CustomerId id) = id +let validator = createValidatorFor() { + validateSingleCaseUnion (fun c -> c.id) unwrapCustomerId [ + isNotEmpty + hasMaxLengthOf 10 + ] +} +``` + +For an excellent article on single case union types see [F# for Fun and Profit](https://fsharpforfunandprofit.com/posts/designing-with-types-single-case-dus/). + +### Multiple Case + +We can handle multiple case discriminated unions using the validateUnion command. Consider the following model: + +```fsharp +type MultiCaseUnion = + | NumericValue of double + | StringValue of string + +type UnionExample = + { + value: MultiCaseUnion + } +``` + +To validate the contents of the union we need to unwrap and apply the appropriate validators based on the union case which we can do as shown below: + +```fsharp +let unionValidator = createValidatorFor() { + validateUnion (fun o -> o.value) (fun v -> match v with | StringValue s -> Unwrapped(s) | _ -> Ignore) [ + isNotEmpty + hasMinLengthOf 10 + ] + + validateUnion (fun o -> o.value) (fun v -> match v with | NumericValue n -> Unwrapped(n) | _ -> Ignore) [ + isGreaterThan 0. + ] +} +``` + +Essentially the _validateUnion_ command takes a parameter that supports a match and it, itself, returns a discriminated union. Return _Unwrapped(value)_ to have the validation block run on the unwrapped value or return Ignore to have it skip that. + ## Option Types To deal with option types in records use _validateRequired, validateUnrequired, validateRequiredWhen and validateUnrequiredWhen_ instead of the already introduced _validate_ and _validateWhen_ commands. @@ -312,6 +373,7 @@ The library includes a number of basic value validators (as seen in the examples |isLessThanOrEqualTo _maxValue_|Is the tested value less than or equal to _maxValue_| |isEmpty|Is the tested value empty| |isNotEmpty|Is the sequence (including a string) not empty| +|isNotNull|Ensure the value is not null| |eachItemWith _validator_|Apply _validator_ to each item in a sequence| |hasLengthOf _length_|Is the sequence (including a string) of length _length_| |hasMinLengthOf _length_|Is the sequence (including a string) of a minimum length of _length_| diff --git a/samples/Demo/Program.fs b/samples/Demo/Program.fs index 55ad689..a50ba92 100644 --- a/samples/Demo/Program.fs +++ b/samples/Demo/Program.fs @@ -39,6 +39,21 @@ type OptionalExample = { message: string option } +type SingleCaseId = SingleCaseId of string + +type EntityWithSingleUnionId = { + id: SingleCaseId +} + +type MultiCaseUnion = + | NumericValue of double + | StringValue of string + +type UnionExample = + { + value: MultiCaseUnion + } + [] let main _ = // A helper function to output @@ -287,6 +302,35 @@ let main _ = printf "Should pass due to having a message and it being within the length constraint\n" { value= 10 ; message = Some "0123456789" } |> optionalUnrequiredValidator |> outputToConsole + + let unwrap (SingleCaseId id) = id + let singleCaseIdValidator = createValidatorFor() { + validateSingleCaseUnion (fun o -> o.id) unwrap [ + isNotEmpty + hasMaxLengthOf 36 + ] + } + + printf "Single case union validation should succeed\n" + { id = SingleCaseId("123") } |> singleCaseIdValidator |> outputToConsole + + + let unionValidator = createValidatorFor() { + validateUnion (fun o -> o.value) (fun v -> match v with | StringValue s -> Unwrapped(s) | _ -> Ignore) [ + isNotEmpty + hasMinLengthOf 10 + ] + + validateUnion (fun o -> o.value) (fun v -> match v with | NumericValue n -> Unwrapped(n) | _ -> Ignore) [ + isGreaterThan 0. + ] + } + + printf "Should fail validation on a string rule\n" + { value = StringValue("jim") } |> unionValidator |> outputToConsole + printf "Should fail validation on a numeric rule" + { value = NumericValue(-5.5) } |> unionValidator |> outputToConsole + 0 diff --git a/src/AccidentalFish.FSharp.Validation/AccidentalFish.FSharp.Validation.fsproj b/src/AccidentalFish.FSharp.Validation/AccidentalFish.FSharp.Validation.fsproj index 9958208..8353c5e 100644 --- a/src/AccidentalFish.FSharp.Validation/AccidentalFish.FSharp.Validation.fsproj +++ b/src/AccidentalFish.FSharp.Validation/AccidentalFish.FSharp.Validation.fsproj @@ -2,7 +2,7 @@ netstandard2.0 - 0.9.0 + 0.10.0 Accidental Fish Validation James Randall Simple F# DSL style record validation framework diff --git a/src/AccidentalFish.FSharp.Validation/Validation.fs b/src/AccidentalFish.FSharp.Validation/Validation.fs index 56b6e73..fff2d3e 100644 --- a/src/AccidentalFish.FSharp.Validation/Validation.fs +++ b/src/AccidentalFish.FSharp.Validation/Validation.fs @@ -19,6 +19,10 @@ module Validation = predicate: (obj -> bool) validators: (obj -> ValidationState) list } + + type MatchResult<'propertyType> = + | Unwrapped of 'propertyType + | Ignore let private getPropertyPath (expression:Expression>) = let objectQualifiedExpression = expression.Body.ToString() @@ -34,6 +38,25 @@ module Validation = let propertyGetter = propertyGetterExpr.Compile() fun (value:obj) -> validator propertyName (propertyGetter.Invoke(value :?> 'targetType)) + let private packageValidatorWithSingleCaseUnwrapper (propertyGetterExpr:Expression>) + (unwrapper:'wrappedPropertyType -> 'propertyType) + (validator:(string -> 'propertyType -> ValidationState)) = + let propertyName = propertyGetterExpr |> getPropertyPath + + let propertyGetter = propertyGetterExpr.Compile() + fun (value:obj) -> validator propertyName (unwrapper (propertyGetter.Invoke(value :?> 'targetType))) + + let private packageValidatorWithUnwrapper (propertyGetterExpr:Expression>) + (unwrapper:'wrappedPropertyType -> MatchResult<'propertyType>) + (validator:(string -> 'propertyType -> ValidationState)) = + let propertyName = propertyGetterExpr |> getPropertyPath + + let propertyGetter = propertyGetterExpr.Compile() + fun (value:obj) -> + match (unwrapper (propertyGetter.Invoke(value :?> 'targetType))) with + | Unwrapped unwrappedValue -> validator propertyName unwrappedValue + | Ignore -> Ok + let private packageValidatorRequired (propertyGetterExpr:Expression>) (validator:(string -> 'propertyType -> ValidationState)) = let propertyName = propertyGetterExpr |> getPropertyPath @@ -82,6 +105,32 @@ module Validation = validators = validatorFunctions |> Seq.map (packageValidator propertyGetter) |> Seq.toList } ] |> Seq.toList + + [] + member this.validateSingleCaseUnion(config: PropertyValidatorConfig list, + propertyGetter:Expression>, + (unwrapper:'wrappedPropertyType -> 'propertyType), + validatorFunctions:(string -> 'propertyType -> ValidationState) list) = + config + |> Seq.append [ + { + predicate = (fun _ -> true) |> packagePredicate + validators = validatorFunctions |> Seq.map (packageValidatorWithSingleCaseUnwrapper propertyGetter unwrapper) |> Seq.toList + } + ] |> Seq.toList + + [] + member this.validateUnion(config: PropertyValidatorConfig list, + propertyGetter:Expression>, + (unwrapper:'wrappedPropertyType -> MatchResult<'propertyType>), + validatorFunctions:(string -> 'propertyType -> ValidationState) list) = + config + |> Seq.append [ + { + predicate = (fun _ -> true) |> packagePredicate + validators = validatorFunctions |> Seq.map (packageValidatorWithUnwrapper propertyGetter unwrapper) |> Seq.toList + } + ] |> Seq.toList [] member this.validateRequired (config: PropertyValidatorConfig list, @@ -157,6 +206,11 @@ module Validation = | true -> Ok | false -> Errors([{ message = sprintf "Must not be equal to %O" comparisonValue; property = propertyName ; errorCode = "isNotEqualTo" }]) comparator + + let isNotNull propertyName value = + match isNull(value) with + | true -> Errors([{ message = "Must not be null"; property = propertyName ; errorCode = "isNotNull" }]) + | false -> Ok // Numeric validators let isGreaterThanOrEqualTo minValue =