1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
open QCheck2
module Suite
(R : Model.CONTRAVARIANT_1)
(F : Preface_specs.DIVISIBLE with type 'a t = 'a R.t)
(A : Model.T0)
(B : Model.T0)
(C : Model.T0) =
struct
module Contravariant = Contravariant.Suite (R) (F) (A) (B) (C)
module Laws = Preface_laws.Divisible.For (F)
let divisible_1 count =
let generator = R.generator A.observable
and input = R.input A.generator in
Util.test ~count (Gen.tup2 generator input) Laws.divisible_1
(fun lhs rhs (f, x) ->
let contra = R.lift f in
let left = lhs contra
and right = rhs contra in
R.run_equality x left right )
;;
let divisible_2 count =
let generator = R.generator A.observable
and input = R.input A.generator in
Util.test ~count (Gen.tup2 generator input) Laws.divisible_2
(fun lhs rhs (f, x) ->
let contra = R.lift f in
let left = lhs contra
and right = rhs contra in
R.run_equality x left right )
;;
let divisible_3 count =
let generator =
Gen.tup3 (R.generator A.observable) (R.generator A.observable)
(R.generator A.observable)
and input = R.input A.generator in
Util.test ~count (Gen.tup2 generator input) Laws.divisible_3
(fun lhs rhs ((f, g, h), x) ->
let contra1 = R.lift f in
let contra2 = R.lift g in
let contra3 = R.lift h in
let left = lhs contra1 contra2 contra3
and right = rhs contra1 contra2 contra3 in
R.run_equality x left right )
;;
let divisible_4 count =
let generator =
Gen.tup2
(fun1 A.observable Gen.(tup2 B.generator C.generator))
(R.generator B.observable)
and input = R.input A.generator in
Util.test ~count (Gen.tup2 generator input) Laws.divisible_4
(fun lhs rhs ((ff, c), x) ->
let contra1 = R.lift c in
let f = Fn.apply ff in
let left = lhs f contra1
and right = rhs f contra1 in
R.run_equality x left right )
;;
let divisible_5 count =
let generator =
Gen.tup2
(fun1 A.observable Gen.(tup2 B.generator C.generator))
(R.generator C.observable)
and input = R.input A.generator in
Util.test ~count (Gen.tup2 generator input) Laws.divisible_5
(fun lhs rhs ((ff, c), x) ->
let contra1 = R.lift c in
let f = Fn.apply ff in
let left = lhs f contra1
and right = rhs f contra1 in
R.run_equality x left right )
;;
let tests ~count =
Contravariant.tests ~count
@ [
divisible_1 count
; divisible_2 count
; divisible_3 count
; divisible_4 count
; divisible_5 count
]
;;
end