2
\$\begingroup\$

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}
        }
\$\endgroup\$

Your Answer

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.

Browse other questions tagged or ask your own question.