contratests.fs

module Test.z

/// Actual test function
type 'a TestCode = 'a -> unit

/// Test tree
type 'a Test =
     | TestCase of 'a TestCode
     | TestList of 'a Test seq
     | TestLabel of string * 'a Test

let rec contramap f =
    function
    | TestCase test -> TestCase (test << f)
    | TestLabel (label, test) -> TestLabel (label, contramap f test)
    | TestList tests -> TestList (Seq.map (contramap f) tests)

let rec runTests (t: 'a Test) (x: 'a): unit =
    match t with
    | TestCase test -> do test x
    | TestLabel (label, test) -> do
                                    printfn "==== %A" label
                                    runTests test x
    | TestList tests -> for z in tests do runTests z x

let test0 (x: int): unit = printfn "test1(%A)" x
let test1 = TestCase test0
let test2 = TestLabel ("Testing something...", test1)
let test3 = TestList [| test2; test2; test2 |]

// ============================================================
> runTests test3 4;;
==== "Testing something..."
test1(4)
==== "Testing something..."
test1(4)
==== "Testing something..."
test1(4)
val it : unit = ()
>

> runTests (contramap (fun x -> 2 * x) test3) 4;;
==== "Testing something..."
test1(8)
==== "Testing something..."
test1(8)
==== "Testing something..."
test1(8)
val it : unit = ()