tests and fixes for Foldable1 Traversable1 impls

Author: matthewleon

src/Data/Array/NonEmpty.js

@@ -16,14 +16,16 @@ exports.traverse1Impl = function () {
     this.fn = fn;
   }
 
+  var emptyList = {};
+
   var ConsCell = function (head, tail) {
     this.head = head;
     this.tail = tail;
   };
 
-  function FinalCell(x) {
-    this.val = x;
-  }
+  function finalCell(head) {
+    return new ConsCell(head, emptyList);
+  };
 
   function consList(x) {
     return function (xs) {
@@ -34,11 +36,10 @@ exports.traverse1Impl = function () {
   function listToArray(list) {
     var arr = [];
     var xs = list;
-    while (xs instanceof ConsCell) {
+    while (xs !== emptyList) {
       arr.push(xs.head);
       xs = xs.tail;
     }
-    arr.push(xs.val);
     return arr;
   }
 
@@ -55,13 +56,14 @@ exports.traverse1Impl = function () {
           } else {
             var last = xs[currentLen - 1];
             return new Cont(function () {
-              return go(buildFrom(last, acc), currentLen - 1, xs);
+              var built = go(buildFrom(last, acc), currentLen - 1, xs);
+              return built;
             });
           }
         };
 
         return function (array) {
-          var acc = new FinalCell(array[array.length - 1]);
+          var acc = map(finalCell)(f(array[array.length - 1]));
           var result = go(acc, array.length - 1, array);
           while (result instanceof Cont) {
             result = result.fn();

src/Data/Array/NonEmpty.purs

@@ -97,7 +97,6 @@ import Control.Alt (class Alt)
 import Control.Alternative (class Alternative)
 import Control.Lazy (class Lazy)
 import Control.Monad.Rec.Class (class MonadRec)
-import Data.Array (foldl)
 import Data.Array as A
 import Data.Bifunctor (bimap)
 import Data.Eq (class Eq1)
@@ -231,10 +230,9 @@ range x y = fromArray $ A.range x y
 
 infix 8 range as ..
 
-replicate :: forall a. Int -> a -> Maybe (NonEmptyArray a)
-replicate i x
-  | i > 0     = Just $ NonEmptyArray $ A.replicate i x
-  | otherwise = Nothing
+-- | Replicate an item at least once
+replicate :: forall a. Int -> a -> NonEmptyArray a
+replicate i x = NonEmptyArray $ A.replicate (max 1 i) x
 
 some
   :: forall f a
@@ -497,8 +495,8 @@ foreign import fold1Impl :: forall a. (a -> a -> a) -> NonEmptyArray a -> a
 
 foreign import traverse1Impl
   :: forall m a b
-   . (m (a -> b) -> m a -> m b)
-  -> ((a -> b) -> m a -> m b)
+   . (forall a' b'. (m (a -> b) -> m a -> m b))
+  -> (forall a' b'. (a -> b) -> m a -> m b)
   -> (a -> m b)
   -> NonEmptyArray a
   -> m (NonEmptyArray b)

test/Test/Data/Array/NonEmpty.purs

@@ -0,0 +1,47 @@
+module Test.Data.Array.NonEmpty (testNonEmptyArray) where
+
+import Prelude
+
+import Control.Monad.Eff (Eff)
+import Control.Monad.Eff.Console (CONSOLE, log)
+import Data.Array.NonEmpty as NEA
+import Data.Foldable (sum)
+import Data.Maybe (Maybe(..), fromJust)
+import Data.Monoid.Additive (Additive(..))
+import Data.Semigroup.Foldable (foldMap1)
+import Data.Semigroup.Traversable (traverse1)
+import Partial.Unsafe (unsafePartial)
+import Test.Assert (ASSERT, assert)
+
+testNonEmptyArray :: forall eff. Eff (console :: CONSOLE, assert :: ASSERT | eff) Unit
+testNonEmptyArray = do
+  log "singleton should construct an array with a single value"
+  assert $ NEA.toArray (NEA.singleton 1) == [1]
+  assert $ NEA.toArray (NEA.singleton "foo") == ["foo"]
+
+  log "range should create an inclusive array of integers for the specified start and end"
+  assert $ NEA.toArray (unsafePartial fromJust (NEA.range 0 5))
+           == [0, 1, 2, 3, 4, 5]
+  assert $ NEA.toArray (unsafePartial fromJust (NEA.range 2 (-3)))
+           == [2, 1, 0, -1, -2, -3]
+
+  log "replicate should produce an array containg an item a specified number of times"
+  assert $ NEA.toArray (NEA.replicate 3 true) == [true, true, true]
+  assert $ NEA.toArray (NEA.replicate 1 "foo") == ["foo"]
+  assert $ NEA.toArray (NEA.replicate 0 "foo") == ["foo"]
+  assert $ NEA.toArray (NEA.replicate (-1) "foo") == ["foo"]
+
+  log "length should return the number of items in an array"
+  assert $ NEA.length (NEA.singleton 1) == 1
+  assert $ NEA.length (unsafePartial fromJust (NEA.fromArray [1, 2, 3, 4, 5]))
+           == 5
+
+  log "foldl should work"
+  -- test through sum
+  assert $ sum (unsafePartial fromJust (NEA.fromArray [1, 2, 3, 4])) == 10
+
+  log "foldMap1 should work"
+  assert $ foldMap1 Additive (unsafePartial fromJust (NEA.fromArray [1, 2, 3, 4])) == Additive 10
+  
+  log "traverse1 should work"
+  assert $ traverse1 Just (unsafePartial fromJust (NEA.fromArray [1, 2, 3, 4])) == NEA.fromArray [1, 2, 3, 4]

test/Test/Main.purs

@@ -10,10 +10,12 @@ import Test.Data.Array (testArray)
 import Test.Data.Array.Partial (testArrayPartial)
 import Test.Data.Array.ST (testArrayST)
 import Test.Data.Array.ST.Partial (testArraySTPartial)
+import Test.Data.Array.NonEmpty (testNonEmptyArray)
 
 main :: forall eff. Eff (console :: CONSOLE, assert :: ASSERT | eff) Unit
 main = do
   testArray
   testArrayST
   testArrayPartial
   testArraySTPartial
+  testNonEmptyArray