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 "\w{2}\d{2}") 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} } 