Sort undefined according to the comparison function (#195)

Author: kl0tl

src/Data/Array.js

@@ -270,13 +270,65 @@ exports.scanr = function (f) {
 // Sorting ---------------------------------------------------------------------
 //------------------------------------------------------------------------------
 
-exports.sortImpl = function (f) {
-  return function (l) {
-    return l.slice().sort(function (x, y) {
-      return f(x)(y);
-    });
+exports.sortByImpl = (function () {
+  function mergeFromTo(compare, fromOrdering, xs1, xs2, from, to) {
+    var mid;
+    var i;
+    var j;
+    var k;
+    var x;
+    var y;
+    var c;
+
+    mid = from + ((to - from) >> 1);
+    if (mid - from > 1) mergeFromTo(compare, fromOrdering, xs2, xs1, from, mid);
+    if (to - mid > 1) mergeFromTo(compare, fromOrdering, xs2, xs1, mid, to);
+
+    i = from;
+    j = mid;
+    k = from;
+    while (i < mid && j < to) {
+      x = xs2[i];
+      y = xs2[j];
+      c = fromOrdering(compare(x)(y));
+      if (c > 0) {
+        xs1[k++] = y;
+        ++j;
+      }
+      else if (c === 0) {
+        xs1[k++] = x;
+        xs1[k++] = y;
+        ++i;
+        ++j;
+      }
+      else {
+        xs1[k++] = x;
+        ++i;
+      }
+    }
+    while (i < mid) {
+      xs1[k++] = xs2[i++];
+    }
+    while (j < to) {
+      xs1[k++] = xs2[j++];
+    }
+  }
+
+  return function (compare) {
+    return function (fromOrdering) {
+      return function (xs) {
+        var out;
+
+        if (xs.length < 2) return xs;
+
+        out = xs.slice(0);
+        mergeFromTo(compare, fromOrdering, out, xs.slice(0), 0, xs.length);
+
+        return out;
+      };
+    };
   };
-};
+})();
 
 //------------------------------------------------------------------------------
 // Subarrays -------------------------------------------------------------------

src/Data/Array.purs

@@ -801,12 +801,10 @@ sort xs = sortBy compare xs
 -- | ```
 -- |
 sortBy :: forall a. (a -> a -> Ordering) -> Array a -> Array a
-sortBy comp xs = sortImpl comp' xs
-  where
-  comp' x y = case comp x y of
-    GT -> 1
-    EQ -> 0
-    LT -> -1
+sortBy comp = sortByImpl comp case _ of
+  GT -> 1
+  EQ -> 0
+  LT -> -1
 
 -- | Sort the elements of an array in increasing order, where elements are
 -- | sorted based on a projection
@@ -819,7 +817,7 @@ sortBy comp xs = sortImpl comp' xs
 sortWith :: forall a b. Ord b => (a -> b) -> Array a -> Array a
 sortWith f = sortBy (comparing f)
 
-foreign import sortImpl :: forall a. (a -> a -> Int) -> Array a -> Array a
+foreign import sortByImpl :: forall a. (a -> a -> Ordering) -> (Ordering -> Int) -> Array a -> Array a
 
 --------------------------------------------------------------------------------
 -- Subarrays -------------------------------------------------------------------

src/Data/Array/ST.js

@@ -98,15 +98,64 @@ exports.freeze = copyImpl;
 
 exports.thaw = copyImpl;
 
-exports.sortByImpl = function (comp) {
-  return function (xs) {
-    return function () {
-      return xs.sort(function (x, y) {
-        return comp(x)(y);
-      });
+exports.sortByImpl = (function () {
+  function mergeFromTo(compare, fromOrdering, xs1, xs2, from, to) {
+    var mid;
+    var i;
+    var j;
+    var k;
+    var x;
+    var y;
+    var c;
+
+    mid = from + ((to - from) >> 1);
+    if (mid - from > 1) mergeFromTo(compare, fromOrdering, xs2, xs1, from, mid);
+    if (to - mid > 1) mergeFromTo(compare, fromOrdering, xs2, xs1, mid, to);
+
+    i = from;
+    j = mid;
+    k = from;
+    while (i < mid && j < to) {
+      x = xs2[i];
+      y = xs2[j];
+      c = fromOrdering(compare(x)(y));
+      if (c > 0) {
+        xs1[k++] = y;
+        ++j;
+      }
+      else if (c === 0) {
+        xs1[k++] = x;
+        xs1[k++] = y;
+        ++i;
+        ++j;
+      }
+      else {
+        xs1[k++] = x;
+        ++i;
+      }
+    }
+    while (i < mid) {
+      xs1[k++] = xs2[i++];
+    }
+    while (j < to) {
+      xs1[k++] = xs2[j++];
+    }
+  }
+
+  return function (compare) {
+    return function (fromOrdering) {
+      return function (xs) {
+        return function () {
+          if (xs.length < 2) return xs;
+
+          mergeFromTo(compare, fromOrdering, xs, xs.slice(0), 0, xs.length);
+
+          return xs;
+        };
+      };
     };
   };
-};
+})();
 
 exports.toAssocArray = function (xs) {
   return function () {

src/Data/Array/ST.purs

@@ -102,16 +102,15 @@ sortBy
    . (a -> a -> Ordering)
   -> STArray h a
   -> ST h (STArray h a)
-sortBy comp = sortByImpl comp'
-  where
-  comp' x y = case comp x y of
-    GT -> 1
-    EQ -> 0
-    LT -> -1
+sortBy comp = sortByImpl comp case _ of
+  GT -> 1
+  EQ -> 0
+  LT -> -1
 
 foreign import sortByImpl
   :: forall a h
-   . (a -> a -> Int)
+   . (a -> a -> Ordering)
+  -> (Ordering -> Int)
   -> STArray h a
   -> ST h (STArray h a)
 

test/Test/Data/Array.purs

@@ -15,6 +15,7 @@ import Effect (Effect)
 import Effect.Console (log)
 import Partial.Unsafe (unsafePartial)
 import Test.Assert (assert)
+import Test.Data.UndefinedOr (defined, undefined)
 
 testArray :: Effect Unit
 testArray = do
@@ -281,6 +282,7 @@ testArray = do
 
   log "sort should reorder a list into ascending order based on the result of compare"
   assert $ A.sort [1, 3, 2, 5, 6, 4] == [1, 2, 3, 4, 5, 6]
+  assert $ A.sort [defined 1, undefined, defined 2] == [undefined, defined 1, defined 2]
 
   log "sortBy should reorder a list into ascending order based on the result of a comparison function"
   assert $ A.sortBy (flip compare) [1, 3, 2, 5, 6, 4] == [6, 5, 4, 3, 2, 1]

test/Test/Data/Array/NonEmpty.purs

@@ -18,6 +18,7 @@ import Effect (Effect)
 import Effect.Console (log)
 import Partial.Unsafe (unsafePartial)
 import Test.Assert (assert)
+import Test.Data.UndefinedOr (defined, undefined)
 
 testNonEmptyArray :: Effect Unit
 testNonEmptyArray = do
@@ -202,6 +203,7 @@ testNonEmptyArray = do
 
   log "sort should reorder a list into ascending order based on the result of compare"
   assert $ NEA.sort (fromArray [1, 3, 2, 5, 6, 4]) == fromArray [1, 2, 3, 4, 5, 6]
+  assert $ NEA.sort (fromArray [defined 1, undefined, defined 2]) == fromArray [undefined, defined 1, defined 2]
 
   log "sortBy should reorder a list into ascending order based on the result of a comparison function"
   assert $ NEA.sortBy (flip compare) (fromArray [1, 3, 2, 5, 6, 4]) == fromArray [6, 5, 4, 3, 2, 1]

test/Test/Data/Array/ST.purs

@@ -10,6 +10,7 @@ import Data.Maybe (Maybe(..), isNothing)
 import Effect (Effect)
 import Effect.Console (log)
 import Test.Assert (assert)
+import Test.Data.UndefinedOr (defined, undefined)
 
 testArrayST :: Effect Unit
 testArrayST = do
@@ -224,6 +225,9 @@ testArrayST = do
   assert $ STA.run (
     STA.sort =<< STA.unsafeThaw [1, 3, 2, 5, 6, 4]
   ) == [1, 2, 3, 4, 5, 6]
+  assert $ STA.run (
+    STA.sort =<< STA.unsafeThaw [defined 1, undefined, defined 2]
+  ) == [undefined, defined 1, defined 2]
 
   log "sortBy should reorder a list into ascending order based on the result of a comparison function"
   assert $ STA.run (

test/Test/Data/UndefinedOr.js

@@ -0,0 +1,30 @@
+exports.undefined = undefined;
+
+exports.defined = function (x) {
+  return x;
+};
+
+exports.eqUndefinedOrImpl = function (eq) {
+  return function (a) {
+    return function (b) {
+      return (a === undefined && b === undefined) || eq(a)(b);
+    };
+  };
+};
+
+exports.compareUndefinedOrImpl = function (lt) {
+  return function (eq) {
+    return function (gt) {
+      return function (compare) {
+        return function (a) {
+          return function (b) {
+            if (a === undefined && b === undefined) return eq;
+            if (a === undefined) return lt;
+            if (b === undefined) return gt;
+            return compare(a)(b);
+          };
+        };
+      };
+    };
+  };
+};

test/Test/Data/UndefinedOr.purs

@@ -0,0 +1,17 @@
+module Test.Data.UndefinedOr where
+
+import Prelude
+
+foreign import data UndefinedOr :: Type -> Type
+
+foreign import undefined :: forall a. UndefinedOr a
+foreign import defined :: forall a. a -> UndefinedOr a
+
+foreign import eqUndefinedOrImpl :: forall a. (a -> a -> Boolean) -> UndefinedOr a -> UndefinedOr a -> Boolean
+foreign import compareUndefinedOrImpl :: forall a. Ordering -> Ordering -> Ordering -> (a -> a -> Ordering) -> UndefinedOr a -> UndefinedOr a -> Ordering
+
+instance eqUndefinedOr :: Eq a => Eq (UndefinedOr a) where
+  eq = eqUndefinedOrImpl eq
+
+instance ordUndefinedOr :: Ord a => Ord (UndefinedOr a) where
+  compare = compareUndefinedOrImpl LT EQ GT compare