NonEmptyArray: Unfoldable1 support

ported by hand from #138

Author: kritzcreek

src/Data/Array/NonEmpty.purs

@@ -8,6 +8,7 @@ module Data.Array.NonEmpty
   , fromFoldable
   , fromFoldable1
   , toUnfoldable
+  , toUnfoldable1
   , singleton
   , (..), range
   , replicate
@@ -105,8 +106,9 @@ import Data.Foldable (class Foldable)
 import Data.Maybe (Maybe(..), fromJust)
 import Data.NonEmpty (NonEmpty, (:|))
 import Data.Semigroup.Foldable (class Foldable1)
-import Data.Tuple (Tuple)
+import Data.Tuple (Tuple(..))
 import Data.Unfoldable (class Unfoldable)
+import Data.Unfoldable1 (class Unfoldable1, unfoldr1)
 import Partial.Unsafe (unsafePartial)
 import Unsafe.Coerce (unsafeCoerce)
 
@@ -159,6 +161,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 = unsafeFromArray <<< A.singleton
 

src/Data/Array/NonEmpty/Internal.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/Internal.purs

@@ -7,11 +7,15 @@ 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, isNothing)
 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, fst, snd)
+import Data.Unfoldable1 (class Unfoldable1)
+import Partial.Unsafe (unsafePartial)
 
 newtype NonEmptyArray a = NonEmptyArray (Array a)
 
@@ -24,6 +28,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
 
@@ -34,10 +40,13 @@ 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
 
-instance traversable1NonEmptyArray :: Traversable1 NonEmptyArray where
+instance traversable1NonEmptyArray :: Traversable1 NonEmptyArray where
   traverse1 = traverse1Impl apply map
   sequence1 = sequence1Default
 
@@ -51,9 +60,19 @@ derive newtype instance monadNonEmptyArray :: Monad NonEmptyArray
 
 derive newtype instance altNonEmptyArray :: Alt NonEmptyArray
 
--- we use FFI here to avoid the unnecessary copy created by `tail`
+-- we use FFI here to avoid the unncessary copy created by `tail`
 foreign import fold1Impl :: forall a. (a -> a -> a) -> NonEmptyArray a -> a
 
+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
+
 foreign import traverse1Impl
   :: forall m a b
    . (forall a' b'. (m (a' -> b') -> m a' -> m b'))

test/Test/Data/Array/NonEmpty.purs

@@ -2,17 +2,20 @@ module Test.Data.Array.NonEmpty (testNonEmptyArray) where
 
 import Prelude
 
+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 Effect (Effect)
-import Effect.Console (log, logShow)
+import Effect.Console (log)
 import Partial.Unsafe (unsafePartial)
 import Test.Assert (assert)
 
@@ -288,6 +291,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