Skip to content

Commit

Permalink
Added explicit support for discriminated unions
Browse files Browse the repository at this point in the history
  • Loading branch information
JamesRandall committed Aug 19, 2019
1 parent 25c53a5 commit 3eb7cb9
Show file tree
Hide file tree
Showing 4 changed files with 161 additions and 1 deletion.
62 changes: 62 additions & 0 deletions README.md
Expand Up @@ -289,6 +289,67 @@ let validator = createValidatorFor<DiscountOrder>() {
}
```

## 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<Customer>() {
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<UnionExample>() {
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.
Expand All @@ -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_|
Expand Down
44 changes: 44 additions & 0 deletions samples/Demo/Program.fs
Expand Up @@ -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
}

[<EntryPoint>]
let main _ =
// A helper function to output
Expand Down Expand Up @@ -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<EntityWithSingleUnionId>() {
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<UnionExample>() {
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


Expand Up @@ -2,7 +2,7 @@

<PropertyGroup>
<TargetFramework>netstandard2.0</TargetFramework>
<PackageVersion>0.9.0</PackageVersion>
<PackageVersion>0.10.0</PackageVersion>
<Title>Accidental Fish Validation</Title>
<Authors>James Randall</Authors>
<Description>Simple F# DSL style record validation framework </Description>
Expand Down
54 changes: 54 additions & 0 deletions src/AccidentalFish.FSharp.Validation/Validation.fs
Expand Up @@ -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<Func<'commandType, 'propertyType>>) =
let objectQualifiedExpression = expression.Body.ToString()
Expand All @@ -34,6 +38,25 @@ module Validation =
let propertyGetter = propertyGetterExpr.Compile()
fun (value:obj) -> validator propertyName (propertyGetter.Invoke(value :?> 'targetType))

let private packageValidatorWithSingleCaseUnwrapper (propertyGetterExpr:Expression<Func<'targetType, 'wrappedPropertyType>>)
(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<Func<'targetType, 'wrappedPropertyType>>)
(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<Func<'targetType, 'propertyType option>>) (validator:(string -> 'propertyType -> ValidationState)) =
let propertyName = propertyGetterExpr |> getPropertyPath

Expand Down Expand Up @@ -82,6 +105,32 @@ module Validation =
validators = validatorFunctions |> Seq.map (packageValidator propertyGetter) |> Seq.toList
}
] |> Seq.toList

[<CustomOperation("validateSingleCaseUnion")>]
member this.validateSingleCaseUnion(config: PropertyValidatorConfig list,
propertyGetter:Expression<Func<'targetType,'wrappedPropertyType>>,
(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

[<CustomOperation("validateUnion")>]
member this.validateUnion(config: PropertyValidatorConfig list,
propertyGetter:Expression<Func<'targetType,'wrappedPropertyType>>,
(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

[<CustomOperation("validateRequired")>]
member this.validateRequired (config: PropertyValidatorConfig list,
Expand Down Expand Up @@ -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 =
Expand Down

0 comments on commit 3eb7cb9

Please sign in to comment.