aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/abstract/order.lux
blob: a4bff03e9698880cb1420cd1837355002ecb9085 (plain)
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
(.module:
  [lux #*
   ["_" test (#+ Test)]
   [abstract/monad (#+ do)]
   [data
    [text
     ["%" format (#+ format)]]
    [number
     ["n" nat]]]
   [math
    ["r" random (#+ Random)]]]
  {1
   ["." / (#+ Order)]})

(def: #export test
  Test
  (<| (_.context (%.name (name-of /.Codec)))
      (do r.monad
        [left r.nat
         right (|> r.nat (r.filter (|>> (n.= left) not)))])
      ($_ _.and
          (_.test (format (%.name (name-of /.min)) " &&& " (%.name (name-of /.max)))
                  (n.< (/.max n.order left right)
                       (/.min n.order left right)))
          )))

(def: #export (spec (^open ",@.") generator)
  (All [a] (-> (Order a) (Random a) Test))
  (<| (_.context (%.name (name-of /.Order)))
      (do r.monad
        [parameter generator
         subject generator])
      ($_ _.and
          (_.test "Values are either ordered, or they are equal. All options are mutually exclusive."
                  (cond (,@< parameter subject)
                        (not (or (,@< subject parameter)
                                 (,@= parameter subject)))

                        (,@< subject parameter)
                        (not (,@= parameter subject))

                        ## else
                        (,@= parameter subject))))))