Test for order + fixes for interval.

6 files changed, 89 insertions, 57 deletions

diff --git a/stdlib/source/lux/abstract/fold.lux b/stdlib/source/lux/abstract/fold.lux
index 504f41f58..a63dc8e20 100644
--- a/stdlib/source/lux/abstract/fold.lux
+++ b/stdlib/source/lux/abstract/fold.lux
@@ -12,7 +12,5 @@
 (def: #export (with-monoid monoid fold value)
   (All [F a]
     (-> (Monoid a) (Fold F) (F a) a))
-  (let [(^open "monoid;.") monoid]
-    (fold monoid;compose
-          monoid;identity
-          value)))
+  (let [(^open "/@.") monoid]
+    (fold /@compose /@identity value)))
diff --git a/stdlib/source/lux/abstract/interval.lux b/stdlib/source/lux/abstract/interval.lux
index 17e749804..46fe020e1 100644
--- a/stdlib/source/lux/abstract/interval.lux
+++ b/stdlib/source/lux/abstract/interval.lux
@@ -102,12 +102,23 @@
   (All [a] (-> (Interval a) (Interval a) Bit))
   (precedes? sample reference))
 
+(template [<name> <comp>]
+  [(def: #export (<name> reference sample)
+     (All [a] (-> a (Interval a) Bit))
+     (let [(^open ",@.") sample]
+       (and (<comp> reference ,@bottom)
+            (<comp> reference ,@top))))]
+
+  [before? ,@<]
+  [after?  (order.> ,@&order)]
+  )
+
 (def: #export (meets? reference sample)
   (All [a] (-> (Interval a) (Interval a) Bit))
   (let [(^open ",@.") reference
-        limit (:: reference ,@bottom)]
-    (and (order.<= ,@&order limit (:: sample ,@bottom))
-         (,@= limit (:: sample ,@top)))))
+        limit (:: reference bottom)]
+    (and (,@= limit (:: sample top))
+         (order.<= ,@&order limit (:: sample bottom)))))
 
 (def: #export (touches? reference sample)
   (All [a] (-> (Interval a) (Interval a) Bit))
@@ -128,17 +139,6 @@
   [finishes? ,@top    order.>= ,@bottom]
   )
 
-(template [<name> <comp>]
-  [(def: #export (<name> reference sample)
-     (All [a] (-> a (Interval a) Bit))
-     (let [(^open ",@.") sample]
-       (and (<comp> reference ,@bottom)
-            (<comp> reference ,@top))))]
-
-  [before? ,@<]
-  [after?  (order.> ,@&order)]
-  )
-
 (structure: #export equivalence (All [a] (Equivalence (Interval a)))
   (def: (= reference sample)
     (let [(^open ",@.") reference]
diff --git a/stdlib/source/lux/abstract/order.lux b/stdlib/source/lux/abstract/order.lux
index 6f992695a..5634aac80 100644
--- a/stdlib/source/lux/abstract/order.lux
+++ b/stdlib/source/lux/abstract/order.lux
@@ -16,7 +16,7 @@
      <)
   )
 
-(type: (Comparison a)
+(type: #export (Comparison a)
   (-> (Order a) a a Bit))
 
 (def: #export (<= order parameter subject)
@@ -33,7 +33,7 @@
   (or (:: order < subject parameter)
       (:: order = subject parameter)))
 
-(type: (Choice a)
+(type: #export (Choice a)
   (-> (Order a) a a a))
 
 (def: #export (min order x y)
diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux
index b18d1c61b..c0ad0b823 100644
--- a/stdlib/source/test/lux/abstract.lux
+++ b/stdlib/source/test/lux/abstract.lux
@@ -5,7 +5,8 @@
    ["#." codec]
    ["#." enum]
    ["#." equivalence]
-   ["#." interval]])
+   ["#." interval]
+   ["#." order]])
 
 (def: #export test
   Test
@@ -13,4 +14,5 @@
       /codec.test
       /enum.test
       /equivalence.test
-      /interval.test))
+      /interval.test
+      /order.test))
diff --git a/stdlib/source/test/lux/abstract/interval.lux b/stdlib/source/test/lux/abstract/interval.lux
index 92f2a6faf..1a15336f5 100644
--- a/stdlib/source/test/lux/abstract/interval.lux
+++ b/stdlib/source/test/lux/abstract/interval.lux
@@ -20,14 +20,15 @@
    [math
     ["r" random (#+ Random)]]]
   {1
-   ["." / (#+ Interval) (",@." equivalence)]})
+   ["." / (#+ Interval) ("#@." equivalence)]})
 
 (template [<name> <cmp>]
   [(def: #export <name>
      (Random (Interval Nat))
      (do r.monad
        [bottom r.nat
-        top (|> r.nat (r.filter (|>> (n.= bottom) not)))]
+        top (r.filter (|>> (n.= bottom) not)
+                      r.nat)]
        (if (<cmp> top bottom)
          (wrap (/.between n.enum bottom top))
          (wrap (/.between n.enum top bottom)))))]
@@ -49,6 +50,21 @@
       ..outer
       ..singleton))
 
+(def: types
+  Test
+  (do r.monad
+    [inner ..inner
+     outer ..outer
+     singleton ..singleton]
+    ($_ _.and
+        (_.test (%.name (name-of /.inner?))
+                (/.inner? inner))
+        (_.test (%.name (name-of /.outer?))
+                (/.outer? outer))
+        (_.test (%.name (name-of /.singleton?))
+                (/.singleton? singleton))
+        )))
+
 (def: boundaries
   Test
   (do r.monad
@@ -56,14 +72,14 @@
      top r.nat
      #let [interval (/.between n.enum bottom top)]]
     ($_ _.and
-        (_.test "A boundary value belongs to its interval."
+        (_.test (%.name (name-of /.within?))
                 (and (/.within? interval bottom)
                      (/.within? interval top)))
-        (_.test "An interval starts with its bottom."
+        (_.test (%.name (name-of /.starts-with?))
                 (/.starts-with? bottom interval))
-        (_.test "An interval ends with its top."
+        (_.test (%.name (name-of /.ends-with?))
                 (/.ends-with? top interval))
-        (_.test "The boundary values border the interval."
+        (_.test (%.name (name-of /.borders?))
                 (and (/.borders? interval bottom)
                      (/.borders? interval top)))
         )))
@@ -80,7 +96,7 @@
      right-outer ..outer]
     ($_ _.and
         (_.test "The union of an interval to itself yields the same interval."
-                (,@= some-interval (/.union some-interval some-interval)))
+                (/@= some-interval (/.union some-interval some-interval)))
         (_.test "The union of 2 inner intervals is another inner interval."
                 (/.inner? (/.union left-inner right-inner)))
         (_.test "The union of 2 outer intervals yields an inner interval when their complements don't overlap, and an outer when they do."
@@ -101,7 +117,7 @@
      right-outer ..outer]
     ($_ _.and
         (_.test "The intersection of an interval to itself yields the same interval."
-                (,@= some-interval (/.intersection some-interval some-interval)))
+                (/@= some-interval (/.intersection some-interval some-interval)))
         (_.test "The intersection of 2 inner intervals yields an inner interval when they overlap, and an outer when they don't."
                 (if (/.overlaps? left-inner right-inner)
                   (/.inner? (/.intersection left-inner right-inner))
@@ -116,7 +132,7 @@
     [some-interval ..interval]
     ($_ _.and
         (_.test "The complement of a complement is the same as the original."
-                (,@= some-interval (|> some-interval /.complement /.complement)))
+                (/@= some-interval (|> some-interval /.complement /.complement)))
         (_.test "The complement of an interval does not overlap it."
                 (not (/.overlaps? some-interval (/.complement some-interval))))
         )))
@@ -135,10 +151,10 @@
      #let [left (/.singleton n.enum l)
            right (/.singleton n.enum r)]]
     ($_ _.and
-        (_.test "'precedes?' and 'succeeds?' are symetric."
+        (_.test (format (%.name (name-of /.precedes?)) " &&& " (%.name (name-of /.succeeds?)))
                 (and (/.precedes? right left)
                      (/.succeeds? left right)))
-        (_.test "Can check if an interval is before or after some element."
+        (_.test (format (%.name (name-of /.before?)) " &&& " (%.name (name-of /.after?)))
                 (and (/.before? m left)
                      (/.after? m right)))
         )))
@@ -157,14 +173,14 @@
      #let [int-left (/.between n.enum t1 t2)
            int-right (/.between n.enum b t1)]]
     ($_ _.and
-        (_.test "An interval meets another if its top is the other's bottom."
+        (_.test (%.name (name-of /.meets?))
                 (/.meets? int-left int-right))
-        (_.test "Two intervals touch one another if any one meets the other."
+        (_.test (%.name (name-of /.touches?))
                 (/.touches? int-left int-right))
-        (_.test "Can check if 2 intervals start together."
+        (_.test (%.name (name-of /.starts?))
                 (/.starts? (/.between n.enum b t2)
                            (/.between n.enum b t1)))
-        (_.test "Can check if 2 intervals finish together."
+        (_.test (%.name (name-of /.finishes?))
                 (/.finishes? (/.between n.enum b t2)
                              (/.between n.enum t1 t2)))
         )))
@@ -220,13 +236,15 @@
   (<| (_.context (%.name (name-of /.Interval)))
       ($_ _.and
           ($equivalence.spec /.equivalence ..interval)
+          (<| (_.context "Types.")
+              ..types)
           (<| (_.context "Boundaries.")
               ..boundaries)
-          (<| (_.context "Union.")
+          (<| (_.context (%.name (name-of /.union)))
               ..union)
-          (<| (_.context "Intersection.")
+          (<| (_.context (%.name (name-of /.intersection)))
               ..intersection)
-          (<| (_.context "Complement.")
+          (<| (_.context (%.name (name-of /.complement)))
               ..complement)
           (<| (_.context "Positioning/location.")
               ..location)
@@ -236,14 +254,14 @@
               ..overlap)
           )))
 
-(def: #export (spec (^open ",@.") gen-sample)
+(def: #export (spec (^open "/@.") gen-sample)
   (All [a] (-> (Interval a) (Random a) Test))
   (<| (_.context (%.name (name-of /.Interval)))
       (do r.monad
         [sample gen-sample]
         ($_ _.and
             (_.test "No value is bigger than the top."
-                    (,@< ,@top sample))
+                    (/@< /@top sample))
             (_.test "No value is smaller than the bottom."
-                    (order.> ,@&order ,@bottom sample))
+                    (order.> /@&order /@bottom sample))
             ))))
diff --git a/stdlib/source/test/lux/abstract/order.lux b/stdlib/source/test/lux/abstract/order.lux
index c31ab31e1..a4bff03e9 100644
--- a/stdlib/source/test/lux/abstract/order.lux
+++ b/stdlib/source/test/lux/abstract/order.lux
@@ -4,26 +4,40 @@
    [abstract/monad (#+ do)]
    [data
     [text
-     ["%" format (#+ format)]]]
+     ["%" 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))
-  (do r.monad
-    [parameter generator
-     subject generator]
-    (<| (_.context (%.name (name-of /.Order)))
-        ($_ _.and
-            (_.test "Values are either ordered, or they are equal. All options are mutually exclusive."
-                    (cond (,@< parameter subject)
-                          (not (or (,@< subject parameter)
-                                   (,@= parameter subject)))
+  (<| (_.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))
+                        (,@< subject parameter)
+                        (not (,@= parameter subject))
 
-                          ## else
-                          (,@= parameter subject)))))))
+                        ## else
+                        (,@= parameter subject))))))