FsCheck Generators pattern

Generators.fs

#r "nuget:FsCheck.Xunit"

// Domain types from production code
module Types =
    open System
    
    type EmailAddress = private EmailAddress of string
    module EmailAddress =
        let fromString str =
            if not <| String.IsNullOrWhiteSpace str
            then Ok <| EmailAddress str
            else Error "An email address can not be empty or whitespace"
        
        let asString (EmailAddress v) = v
    
    type TotalSeats = private TotalSeats of int
    module TotalSeats =
        let fromInt value =
            if value > 0
            then Ok <| TotalSeats value
            else Error "Total seats can not be zero"
        
        let asInt (TotalSeats totalSeats) = totalSeats
    
    type MyBox<'t> = MyBox of 't

// Domain type generators
module Generators =
    open FsCheck
    open FsCheck.Xunit
    
    open Types
    
    // Some helper functions
    module NonWhiteSpaceString =
        let asString (NonWhiteSpaceString str) = str

    module Result =
        let valueOrFail = function
            | Ok v -> v
            | Error err -> failwith err
    
    // An abstract class representing a generator/validator/shrinker
    // This class is useful later for creating generator tests
    [<AbstractClass>]
    type AbstractGenerator<'t> () =
        abstract IsValid: 't -> bool
        default this.IsValid _ = true
        
        abstract member Shrink: 't -> 't seq
        
        abstract member Generator: unit -> Gen<'t>
        
        member this.Arbitrary = Arb.fromGenShrink(this.Generator(), this.Shrink)
    
    type ThreeLetter = ThreeLetter of string
    type ThreeLetterGenerator () =
        inherit AbstractGenerator<ThreeLetter>()
        
        override this.Generator () =
            Arb.generate<string>
            |> Gen.filter (fun str -> str <> null)
            |> Gen.filter (fun str -> str.Length = 3)
            |> Gen.map ThreeLetter
            
        override this.IsValid (ThreeLetter r) = r.Length = 3
              
        override this.Shrink (ThreeLetter t) =
            Arb.shrink t
            |> Seq.map ThreeLetter
            |> Seq.filter this.IsValid
    
    // Type used for testing TotalSeats
    type NonZeroOrPositiveInteger = NonZeroOrPositiveInteger of int
    type NonZeroOrPositiveIntegerGenerator () =
        inherit AbstractGenerator<NonZeroOrPositiveInteger>()
        
        let isValid i = i > 0

        override this.Generator () =
            Arb.generate<int>
            |> Gen.filter isValid
            |> Gen.map NonZeroOrPositiveInteger
        
        override this.IsValid (NonZeroOrPositiveInteger i) = isValid i
        
        override this.Shrink (NonZeroOrPositiveInteger i) =
            Arb.shrink i
            |> Seq.map NonZeroOrPositiveInteger
            |> Seq.filter this.IsValid
        
    // Type used for testing TotalSeats
    type ZeroOrNegativeInteger = ZeroOrNegativeInteger of int
    type ZeroOrNegativeIntegerGenerator () =
        inherit AbstractGenerator<ZeroOrNegativeInteger>()
        
        let isValid i = i <= 0

        override this.Generator () =
            Arb.generate<int>
            |> Gen.filter isValid
            |> Gen.map ZeroOrNegativeInteger
        
        override this.IsValid (ZeroOrNegativeInteger i) = isValid i
        
        override this.Shrink (ZeroOrNegativeInteger i) =
            Arb.shrink i
            |> Seq.map ZeroOrNegativeInteger
            |> Seq.filter this.IsValid
    
    type EmailAddressGenerator () =
        inherit AbstractGenerator<EmailAddress>()

        override this.Generator () =
            Arb.generate<NonWhiteSpaceString>
            |> Gen.map NonWhiteSpaceString.asString
            |> Gen.map EmailAddress.fromString
            |> Gen.map Result.valueOrFail
        
        override this.Shrink emailAddress =
            EmailAddress.asString emailAddress
            |> Arb.shrink
            |> Seq.map EmailAddress.fromString
            |> Seq.map Result.toOption
            |> Seq.choose id
    
    type MyBoxGenerator<'t> (contents: Arbitrary<'t>) =
        inherit AbstractGenerator<MyBox<'t>>()
        
        // required for Generator tests
        new() = MyBoxGenerator(Arb.Default.Derive<'t>())
        
        override this.Generator () =
            gen {
                let! v = contents.Generator
                
                return MyBox v
            }
        
        override this.Shrink (MyBox v) =
            v
            |> contents.Shrinker
            |> Seq.map MyBox

    
    type MyGenerators =
        static member EmailAddress () = EmailAddressGenerator().Arbitrary
        static member NonZeroOrPositiveInteger () = NonZeroOrPositiveIntegerGenerator().Arbitrary
        static member ZeroOrNegativeInteger () = ZeroOrNegativeIntegerGenerator().Arbitrary
        static member MyBox (contents: Arbitrary<'a>) = MyBoxGenerator(contents).Arbitrary
        static member ThreeLetter () = ThreeLetterGenerator().Arbitrary

    type MyPropertyAttribute () =
        inherit PropertyAttribute(Arbitrary = [| typeof<MyGenerators> |])

module GeneratorTests =
    open Types
    open Generators
    
    // An abstract class that instantiates a generator and checks that it creates valid types and valid shrinks
    [<AbstractClass>]
    type AbstractGeneratorTests<'g, 't when 'g :> AbstractGenerator<'t> and 'g: (new : unit -> 'g)>()  =
        let generator = new 'g()
        
        [<MyProperty>]
        member this.``Generator creates valid types`` t =
            generator.IsValid t
        
        [<MyProperty>]
        member this.``Shrink creates valid types`` t =
            generator.Shrink t
            |> Seq.forall generator.IsValid
    
    // Concrete tests for each generator
    type EmailAddressGeneratorTests () = inherit AbstractGeneratorTests<EmailAddressGenerator, EmailAddress>()
    type NonZeroOrPositiveIntegerGeneratorTests () = inherit AbstractGeneratorTests<NonZeroOrPositiveIntegerGenerator, NonZeroOrPositiveInteger>()
    type ZeroOrNegativeIntegerGeneratorTests() = inherit AbstractGeneratorTests<ZeroOrNegativeIntegerGenerator, ZeroOrNegativeInteger>()
    type MyBoxGeneratorTests() = inherit AbstractGeneratorTests<MyBoxGenerator<string>, MyBox<string>>()
    type ThreeLetterGeneratorTests() = inherit AbstractGeneratorTests<ThreeLetterGenerator, ThreeLetter>()

module TypeTests =
    open Types
    open Generators
    
    [<MyProperty>]
    let ``TotalSeats returns error when number is zero or below`` (ZeroOrNegativeInteger value) =
        value
        |> TotalSeats.fromInt
        |> Result.isError
    
    [<MyProperty>]
    let ``TotalSeats returns ok when number is greater than zero`` (NonZeroOrPositiveInteger value) =
        value
        |> TotalSeats.fromInt
        |> Result.isOk
    
    [<MyProperty>]
    let ``Can create a MyBox type`` (myBox: MyBox<string>) =
        not <| obj.ReferenceEquals(myBox, null)

Added a new revision because I realized that using Arb.Default.Derive().Shrinker t was not actually shrinking any values, but instead returning an empty sequence. Changing it to Arb.shrink ended up creating an infinite loop, so I removed the default implementation of Shrink from the AbstractGenerator.