trjhtr

Following the patterns from the book Domain Modeling Made Functional, I am implementing a single-case union for the simple values in my domain model instead of using primitives. The union cases have private constructors, and each union type has a module with a create function that validates the business rules around the type and returns a Result. To simplify the validation of the business rules, I have created a DSL (in the form of an F# Computation Expression) that applies the specified rules (which can be either required or suggested) and then either returns a successful Result or a result with the relevant errors/warnings as domain events.

The BusinessRule DSL is implemented as follows:

open System

// Functions representing the evaluation of a business rule and 
// the creation of an error based on the given value
type BusinessRuleExpr<'value, 'error> = ('value -> bool) * ('value -> 'error)

// Business Rules define the restrictions around the creation of a specific type. 
// These may be either required (which cause an error when not satisfied) or suggested (which only cause a warning)
type BusinessRule<'value, 'error> =
 | Required of BusinessRuleExpr<'value,'error>
 | Suggested of BusinessRuleExpr<'value,'error>

module BusinessRule =
 let inline require eval error =
 [Required (eval, error)]

 let inline suggest eval warn =
 [Suggested (eval, warn)]

 let inline also eval error rules =
 rules @ (require eval error)

 let inline should eval warn rules =
 rules @ (suggest eval warn)

 let inline isRequired rule =
 match rule with
 | Required _ -> true
 | _ -> false

 let inline isSuggested rule =
 match rule with
 | Suggested _ -> true
 | _ -> false

 let inline applies value rule =
 match rule with
 | Required (eval,_) -> eval value 
 | Suggested (eval,_) -> eval value
 |> not

 let inline fail value rule =
 match rule with
 | Required (_,error) -> error value
 | Suggested (_,warn) -> warn value

// Computation Builder for the Business Rule DSL
type BusinessRuleBuilder () =
 member inline __.Yield _ = List.empty
 [<CustomOperation("require")>]
 member inline __.Require (rules: BusinessRule<'value,'error> list, eval: 'value -> bool, error: 'value -> 'error) = 
 rules |> BusinessRule.also eval error
 [<CustomOperation("should")>]
 member inline __.Should (rules: BusinessRule<'value,'error> list, eval: 'value -> bool, warn: 'value -> 'error) = 
 rules |> BusinessRule.should eval warn 

[<AutoOpen>]
module Builder =
 let businessRules = BusinessRuleBuilder()

The computation builder for BusinessRule does no implement Bind or Return as it would for a monadic computation. Instead, I am simply using the computation builder as a way of creating a simple DSL. I'm not sure what the best practices are around computation builders that don't implement Bind/Return, so I'd appreciate any thoughts you may have on that subject.

The business rules themselves are then defined in a separate module:

module Rules =
 open System
 open System.Text.RegularExpressions

 /// Compose function f with functions g and h, and-ing the results
 let private (>>&) f (g, h) x = 
 let r = f x
 g r && h r

 /// Regular-Expression based business rule
 let inline regex pattern = 
 let completePattern = 
 if pattern |> Seq.contains '^' || pattern |> Seq.contains '$'
 then Regex(pattern, RegexOptions.Compiled)
 else Regex(sprintf "^%s$" pattern, RegexOptions.Compiled)
 completePattern.IsMatch

 // String Rules
 let private lengthRule op length = String.length >> op length
 let isNotEmpty = String.IsNullOrWhiteSpace >> not
 let isAlpha = String.forall Char.IsLetter
 let isNumber input = match Decimal.TryParse input with
 | true,_ -> true
 | _ -> false
 let isNumerical = String.forall Char.IsDigit
 let isAlphanumeric = String.forall Char.IsLetterOrDigit
 let isLength = lengthRule (=)
 let maxLength = lengthRule (>=)
 let minLength = lengthRule (<=)
 let lengthBetween min max = String.length >>& ((>=) max, (<=) min)

 // Number rules

 // Could we use LanguagePrimitives.GenericZero instead of Unchecked.defaultOf here?
 let inline private compareZero<'n when 'n: comparison> = LanguagePrimitives.GenericComparison Unchecked.defaultof<'n>
 let isNegative n = n |> (compareZero >> (<) 0)
 let isNotNegative n = n|> (compareZero >> (>=) 0)
 let isNotPositive n = n|> (compareZero >> (<=) 0)
 let isPositive n = n|> (compareZero >> (>) 0)

The rule definitions are generally pretty simple. One thing I'd like to do is replace the Unchecked.defaulof<'n> with LanguagePrimitives.GenericZero<'n> in the compareZero function, but I think I would need a static member on a class to make that work, since the GenericZero function uses an SRTP for the get_Zero member.

Finally, I have this little helper module to simplify the validation of values when constructing the domain models. Note, this uses the CurryOn.FSharp.Control package for a type like Result that includes domain events with successful results as well. This is used to include the warnings with the value for Suggested rules that aren't satisfied.

[<AutoOpen>]
module private Validation =
 open FSharp.Control
 open System.Text.RegularExpressions

 let inline private validate<'a,'b> (ctor: 'a -> 'b) (validations: BusinessRule<'a, DomainErrors> list) (value: 'a) =
 let errors = [for rule in validations |> List.filter BusinessRule.isRequired do if rule |> BusinessRule.applies value then yield rule |> BusinessRule.fail value]
 let warnings = [for rule in validations |> List.filter BusinessRule.isSuggested do if rule |> BusinessRule.applies value then yield rule |> BusinessRule.fail value]
 match errors with
 | -> match warnings with
 | -> Result.success <| ctor value
 | _ -> Result.successWithEvents (ctor value) warnings
 | _ -> Result.failure (errors @ warnings)

 let validateString<'b> (ctor: string -> 'b) (validations: BusinessRule<string, DomainErrors> list) (value: string) =
 if value |> isNull
 then Result.failure [ValueWasNull]
 else validate ctor validations value

 let validateNumber<'a,'b when 'a : comparison> ctor validations = 
 validate<'a,'b> ctor validations

With the BusinessRule DSL and the rules themselves defined, I can then build my simple values for the domain model as follows:

[<Struct>] type CostPrice = private CostPrice of decimal
[<Struct>] type FundType = private FundType of string
[<Struct>] type OrderLineNumber = private OrderLineNumber of int

type ValidationError =
| CostPriceIsNegative of decimal
| FundTypeIsEmpty
| InvalidFundType of string
| OrderLineNumberIsNegative of int
| ValueWasNull

module CostPrice =
 let create = 
 validateNumber CostPrice <|
 businessRules require Rules.isNotNegative CostPriceIsNegative 

 let value (CostPrice price) = price

 let Default = CostPrice 0M

module FundType =
 let create = 
 validateString FundType <|
 businessRules 
 require Rules.isNotEmpty (fun _ -> FundTypeIsEmpty)
 require (Rules.regex "w2d2") InvalidFundType 
 

 let value (FundType fundType) = fundType

module OrderLineNumber =
 let create =
 validateNumber OrderLineNumber <|
 businessRules require Rules.isNotNegative OrderLineNumberIsNegative 

 let value (OrderLineNumber line) = line

 let Default = OrderLineNumber 0

And with all that in place, I can make a Value Object that uses the simple values. This uses the operation computation builder from CurryOn.FSharp.Control to compose the results of each validation.

type Rebate = 
 
 LineNumber: OrderLineNumber
 FundType: FundType
 Amount: CostPrice
 static member create lineNumber fundType amount =
 operation 
 let! validLineNumber = OrderLineNumber.create lineNumber
 let! validFundType = FundType.create fundType
 let! validAmount = CostPrice.create amount
 return LineNumber = validLineNumber; FundType = validFundType; Amount = validAmount