Update Setoid.test to respect constraints

sanctuary-js · Apr 19, 2021 · 697565f · 697565f
1 parent 5b183ac
commit 697565f
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 2 deletions.
diff --git a/index.js b/index.js
@@ -885,7 +885,7 @@
     return {};
   }
 
-  //  Object$prototype$equals :: StrMap a ~> StrMap a -> Boolean
+  //  Object$prototype$equals :: Setoid a => StrMap a ~> StrMap a -> Boolean
   function Object$prototype$equals(other) {
     var self = this;
     var keys = sortedKeys (this);
@@ -1036,6 +1036,15 @@
     return function(x) { return contravariant (f (x)); };
   }
 
+  //  getObjectSetoid :: Setoid b => StrMap a -> Nullable (StrMap b ~> StrMap b -> Boolean)
+  function getObjectSetoid(value) {
+    return (
+      (Object.values (value)).every (Setoid.test) ?
+      Object$prototype$equals :
+      null
+    );
+  }
+
   function implementation(name, value) {
     switch (type (value) + '#' + name) {
       case 'Null#fantasy-land/equals': return Null$prototype$equals;
@@ -1066,7 +1075,7 @@
       case 'Arguments#fantasy-land/equals': return Arguments$prototype$equals;
       case 'Arguments#fantasy-land/lte': return Arguments$prototype$lte;
       case 'Error#fantasy-land/equals': return Error$prototype$equals;
-      case 'Object#fantasy-land/equals': return Object$prototype$equals;
+      case 'Object#fantasy-land/equals': return getObjectSetoid (value);
       case 'Object#fantasy-land/lte': return Object$prototype$lte;
       case 'Object#fantasy-land/concat': return Object$prototype$concat;
       case 'Object#fantasy-land/filter': return Object$prototype$filter;

diff --git a/test/index.js b/test/index.js
@@ -322,6 +322,7 @@ test ('Setoid', function() {
   eq (Z.Setoid.test ([]), true);
   eq (Z.Setoid.test ({}), true);
   eq (Z.Setoid.test ({'@@type': 'my-package/Quux@1'}), false);
+  eq (Z.Setoid.test ({foo: {'@@type': 'my-package/Quux@1'}}), false);
 });
 
 test ('Ord', function() {