Business Rule DSL for Values in Domain-Driven Design

Question

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}
        }