NonEmptyArray: Unfoldable1 support

bower.json

@@ -17,13 +17,12 @@
   ],
   "dependencies": {
     "purescript-foldable-traversable": "^3.3.0",
-    "purescript-nonempty": "^4.0.0",
     "purescript-partial": "^1.2.0",
     "purescript-st": "^3.0.0",
     "purescript-tailrec": "^3.0.0",
     "purescript-tuples": "^4.0.0",
-    "purescript-unfoldable": "^3.0.0",
-    "purescript-unsafe-coerce": "^3.0.0"
+    "purescript-unsafe-coerce": "^3.0.0",
+    "purescript-nonempty": "^4.3.0"
   },
   "devDependencies": {
     "purescript-assert": "^3.0.0",

src/Data/Array/NonEmpty.js

@@ -11,6 +11,27 @@ exports.fold1Impl = function (f) {
   };
 };
 
+exports.unfoldr1Impl = function (isNothing) {
+  return function (fromJust) {
+    return function (fst) {
+      return function (snd) {
+        return function (f) {
+          return function (value) {
+            var result = [];
+            while (true) { // eslint-disable-line no-constant-condition
+              var tuple = f(value);
+              result.push(fst(tuple));
+              var maybe = snd(tuple);
+              if (isNothing(maybe)) return result;
+              value = fromJust(maybe); // eslint-disable-line no-param-reassign
+            }
+          };
+        };
+      };
+    };
+  };
+};
+
 exports.traverse1Impl = function () {
   function Cont(fn) {
     this.fn = fn;

src/Data/Array/NonEmpty.purs

@@ -8,6 +8,7 @@ module Data.Array.NonEmpty
   , fromFoldable
   , fromFoldable1
   , toUnfoldable
+  , toUnfoldable1
   , singleton
   , (..), range
   , replicate
@@ -103,15 +104,16 @@ import Data.Eq (class Eq1)
 import Data.Foldable (class Foldable)
 import Data.FoldableWithIndex (class FoldableWithIndex)
 import Data.FunctorWithIndex (class FunctorWithIndex)
-import Data.Maybe (Maybe(..), fromJust)
+import Data.Maybe (Maybe(..), fromJust, isNothing)
 import Data.NonEmpty (NonEmpty, (:|))
 import Data.Ord (class Ord1)
 import Data.Semigroup.Foldable (class Foldable1, foldMap1Default)
 import Data.Semigroup.Traversable (class Traversable1, sequence1Default)
 import Data.Traversable (class Traversable)
 import Data.TraversableWithIndex (class TraversableWithIndex)
-import Data.Tuple (Tuple)
+import Data.Tuple (Tuple(..), fst, snd)
 import Data.Unfoldable (class Unfoldable)
+import Data.Unfoldable1 (class Unfoldable1, unfoldr1)
 import Partial.Unsafe (unsafePartial)
 
 newtype NonEmptyArray a = NonEmptyArray (Array a)
@@ -125,6 +127,8 @@ derive newtype instance eq1NonEmptyArray :: Eq1 NonEmptyArray
 derive newtype instance ordNonEmptyArray :: Ord a => Ord (NonEmptyArray a)
 derive newtype instance ord1NonEmptyArray :: Ord1 NonEmptyArray 
 
+derive newtype instance semigroupNonEmptyArray :: Semigroup (NonEmptyArray a)
+
 derive newtype instance functorNonEmptyArray :: Functor NonEmptyArray
 derive newtype instance functorWithIndexNonEmptyArray :: FunctorWithIndex Int NonEmptyArray
 
@@ -135,6 +139,9 @@ instance foldable1NonEmptyArray :: Foldable1 NonEmptyArray where
   foldMap1 = foldMap1Default
   fold1 = fold1Impl (<>)
 
+instance unfoldable1NonEmptyArray :: Unfoldable1 NonEmptyArray where
+  unfoldr1 = unfoldr1Impl isNothing (unsafePartial fromJust) fst snd
+
 derive newtype instance traversableNonEmptyArray :: Traversable NonEmptyArray
 derive newtype instance traversableWithIndexNonEmptyArray :: TraversableWithIndex Int NonEmptyArray
 
@@ -152,6 +159,16 @@ derive newtype instance monadNonEmptyArray :: Monad NonEmptyArray
 
 derive newtype instance altNonEmptyArray :: Alt NonEmptyArray
 
+foreign import unfoldr1Impl
+  :: forall a b
+   . (forall x. Maybe x -> Boolean)
+  -> (forall x. Maybe x -> x)
+  -> (forall x y. Tuple x y -> x)
+  -> (forall x y. Tuple x y -> y)
+  -> (b -> Tuple a (Maybe b))
+  -> b
+  -> NonEmptyArray a
+
 -- | Internal - adapt an Array transform to NonEmptyArray
 --
 -- Note that this is unsafe: if the transform returns an empty array, this can
@@ -198,6 +215,13 @@ fromFoldable1 = unsafeFromArray <<< A.fromFoldable
 toUnfoldable :: forall f a. Unfoldable f => NonEmptyArray a -> f a
 toUnfoldable = adaptAny A.toUnfoldable
 
+toUnfoldable1 :: forall f a. Unfoldable1 f => NonEmptyArray a -> f a
+toUnfoldable1 xs = unfoldr1 f 0
+  where
+  len = length xs
+  f i = Tuple (unsafePartial unsafeIndex xs i) $
+          if i < (len - 1) then Just (i + 1) else Nothing
+
 singleton :: forall a. a -> NonEmptyArray a
 singleton = NonEmptyArray <<< A.singleton
 

src/Data/Array/ST.js

@@ -58,6 +58,16 @@ exports.copyImpl = function (xs) {
   };
 };
 
+exports.sortByImpl = function (comp) {
+  return function (xs) {
+    return function () {
+      return xs.sort(function (x, y) {
+        return comp(x)(y);
+      });
+    };
+  };
+};
+
 exports.toAssocArray = function (xs) {
   return function () {
     var n = xs.length;

src/Data/Array/ST.purs

@@ -14,6 +14,9 @@ module Data.Array.ST
   , modifySTArray
   , pushAllSTArray
   , spliceSTArray
+  , sort
+  , sortBy
+  , sortWith
   , freeze
   , thaw
   , unsafeFreeze
@@ -80,6 +83,38 @@ foreign import emptySTArray :: forall a h r. Eff (st :: ST h | r) (STArray h a)
 thaw :: forall a h r. Array a -> Eff (st :: ST h | r) (STArray h a)
 thaw = copyImpl
 
+-- | Sort a mutable array in place.
+sort :: forall a h r. Ord a => STArray h a -> Eff (st :: ST h | r) (STArray h a)
+sort = sortBy compare
+
+-- | Sort a mutable array in place using a comparison function.
+sortBy
+  :: forall a h r
+   . (a -> a -> Ordering)
+  -> STArray h a
+  -> Eff (st :: ST h | r) (STArray h a)
+sortBy comp = sortByImpl comp'
+  where
+  comp' x y = case comp x y of
+    GT -> 1
+    EQ -> 0
+    LT -> -1
+
+foreign import sortByImpl
+  :: forall a h r
+   . (a -> a -> Int)
+  -> STArray h a
+  -> Eff (st :: ST h | r) (STArray h a)
+
+-- | Sort a mutable array in place based on a projection.
+sortWith
+  :: forall a b h r
+   . Ord b
+  => (a -> b)
+  -> STArray h a
+  -> Eff (st :: ST h | r) (STArray h a)
+sortWith f = sortBy (comparing f)
+
 -- | Create an immutable copy of a mutable array.
 freeze :: forall a h r. STArray h a -> Eff (st :: ST h | r) (Array a)
 freeze = copyImpl

test/Test/Data/Array/NonEmpty.purs

@@ -4,15 +4,18 @@ import Prelude
 
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, log)
+import Data.Array as A
 import Data.Array.NonEmpty as NEA
 import Data.Const (Const(..))
 import Data.Foldable (for_, sum, traverse_)
 import Data.FunctorWithIndex (mapWithIndex)
 import Data.Maybe (Maybe(..), fromJust)
 import Data.Monoid.Additive (Additive(..))
+import Data.NonEmpty ((:|))
 import Data.Semigroup.Foldable (foldMap1)
 import Data.Semigroup.Traversable (traverse1)
 import Data.Tuple (Tuple(..))
+import Data.Unfoldable1 as U1
 import Partial.Unsafe (unsafePartial)
 import Test.Assert (ASSERT, assert)
 
@@ -285,6 +288,12 @@ testNonEmptyArray = do
       , fromArray [4,0,0,1,25,36,458,5842,23757]
       ])
 
+  log "toUnfoldable1"
+  assert $ NEA.toUnfoldable1 (NEA.range 0 9) == 0 :| A.range 1 9
+
+  log "Unfoldable instance"
+  assert $ U1.range 0 9 == NEA.range 0 9
+
   log "foldl should work"
   -- test through sum
   assert $ sum (fromArray [1, 2, 3, 4]) == 10

test/Test/Data/Array/ST.purs

@@ -4,7 +4,7 @@ import Prelude
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (log, CONSOLE)
 import Control.Monad.ST (ST, pureST)
-import Data.Array.ST (STArray, emptySTArray, freeze, peekSTArray, pokeSTArray, pushAllSTArray, pushSTArray, spliceSTArray, thaw, toAssocArray, unsafeThaw, unsafeFreeze)
+import Data.Array.ST (STArray, emptySTArray, freeze, peekSTArray, pokeSTArray, pushAllSTArray, pushSTArray, sort, sortBy, sortWith, spliceSTArray, thaw, toAssocArray, unsafeThaw, unsafeFreeze)
 import Data.Foldable (all)
 import Data.Maybe (Maybe(..), isNothing)
 import Test.Assert (assert, ASSERT)
@@ -132,6 +132,21 @@ testArrayST = do
     void $ pokeSTArray arr 1 2
     pure arr) == [1]
 
+  log "sort should reorder a list into ascending order based on the result of compare"
+  assert $ run (
+    sort =<< unsafeThaw [1, 3, 2, 5, 6, 4]
+  ) == [1, 2, 3, 4, 5, 6]
+
+  log "sortBy should reorder a list into ascending order based on the result of a comparison function"
+  assert $ run (
+    sortBy (flip compare) =<< unsafeThaw [1, 3, 2, 5, 6, 4]
+  ) == [6, 5, 4, 3, 2, 1]
+
+  log "sortWith should reorder a list into ascending order based on the result of compare over a projection"
+  assert $ run (
+    sortWith id =<< unsafeThaw [1, 3, 2, 5, 6, 4]
+  ) == [1, 2, 3, 4, 5, 6]
+
   log "spliceSTArray should be able to delete multiple items at a specified index"
 
   assert $ run (do