More tests for Traversable instances

Also use a type synonym to simplify type signatures in Test.Main

Author: hdgarrood

bower.json

@@ -24,6 +24,7 @@
     "purescript-assert": "^2.0.0",
     "purescript-console": "^2.0.0",
     "purescript-integers": "^2.0.0",
-    "purescript-math": "^2.0.0"
+    "purescript-math": "^2.0.0",
+    "purescript-unsafe-coerce": "^2.0.0"
   }
 }

test/Main.js

@@ -7,3 +7,19 @@ exports.arrayFrom1UpTo = function (n) {
   }
   return result;
 };
+
+exports.arrayReplicate = function (n) {
+  return function (x) {
+    var result = [];
+    for (var i = 1; i <= n; i++) {
+      result.push(x);
+    }
+    return result;
+  };
+};
+
+exports.intPow = function (x) {
+  return function (y) {
+    return Math.pow(x,y) | 0;
+  };
+};

test/Main.purs

@@ -13,15 +13,29 @@ import Data.Function (on)
 import Data.Int (toNumber)
 import Data.Maybe (Maybe(..))
 import Data.Monoid.Additive (Additive(..))
+import Data.Newtype (unwrap)
 import Data.Traversable (class Traversable, sequenceDefault, traverse, sequence, traverseDefault)
+import Unsafe.Coerce (unsafeCoerce)
 
 import Math (abs)
 
 import Test.Assert (ASSERT, assert, assert')
 
 foreign import arrayFrom1UpTo :: Int -> Array Int
+foreign import arrayReplicate :: forall a. Int -> a -> Array a
 
-main :: Eff (console :: CONSOLE, assert :: ASSERT) Unit
+foreign import intPow :: Int -> Int -> Int
+
+foldableLength :: forall f a. Foldable f => f a -> Int
+foldableLength = unwrap <<< foldMap (const (Additive 1))
+
+-- Ensure that a value is evaluated 'lazily' by treating it as an Eff action.
+deferEff :: forall e a. (Unit -> a) -> Eff e a
+deferEff = unsafeCoerce
+
+type EffTest = Eff (console :: CONSOLE, assert :: ASSERT)
+
+main :: EffTest Unit
 main = do
   log "Test foldableArray instance"
   testFoldableArrayWith 20
@@ -107,8 +121,8 @@ main = do
   log "All done!"
 
 
-testFoldableFWith :: forall f e. (Foldable f, Eq (f Int)) =>
-                     (Int -> f Int) -> Int -> Eff (assert :: ASSERT | e) Unit
+testFoldableFWith :: forall f. (Foldable f, Eq (f Int)) =>
+                     (Int -> f Int) -> Int -> EffTest Unit
 testFoldableFWith f n = do
   let dat = f n
   let expectedSum = (n / 2) * (n + 1)
@@ -117,25 +131,33 @@ testFoldableFWith f n = do
   assert $ foldl (+) 0 dat == expectedSum
   assert $ foldMap Additive dat == Additive expectedSum
 
-testFoldableArrayWith :: forall eff. Int -> Eff (assert :: ASSERT | eff) Unit
+testFoldableArrayWith :: Int -> EffTest Unit
 testFoldableArrayWith = testFoldableFWith arrayFrom1UpTo
 
 
-testTraversableFWith :: forall f e. (Traversable f, Eq (f Int)) =>
-                        (Int -> f Int) -> Int -> Eff (assert :: ASSERT | e) Unit
+testTraversableFWith :: forall f. (Traversable f, Eq (f Int)) =>
+                        (Int -> f Int) -> Int -> EffTest Unit
 testTraversableFWith f n = do
   let dat = f n
+  let len = foldableLength dat
 
   assert' "traverse Just == Just" $ traverse Just dat == Just dat
-  assert' "traverse pure == pure" $ traverse pure dat == [dat]
+  assert' "traverse pure == pure (Array)" $ traverse pure dat == [dat]
+
+  when (len <= 10) do
+    result <- deferEff \_ -> traverse (\x -> [x,x]) dat == arrayReplicate (intPow 2 len) dat
+    assert' "traverse with Array as underlying applicative" result
+
   assert' "traverse (const Nothing) == const Nothing" $
     traverse (const Nothing :: Int -> Maybe Int) dat == Nothing
+
   assert' "sequence <<< map f == traverse f" $
     sequence (map Just dat) == traverse Just dat
+
   assert' "underlying applicative" $
     (traverse pure dat :: Unit -> f Int) unit == dat
 
-testTraversableArrayWith :: forall eff. Int -> Eff (assert :: ASSERT | eff) Unit
+testTraversableArrayWith :: Int -> EffTest Unit
 testTraversableArrayWith = testTraversableFWith arrayFrom1UpTo
 
 
@@ -175,16 +197,16 @@ instance foldableDFR :: Foldable FoldrDefault where
   foldl f u (FRD a) = foldl f u a
   foldr f u         = foldrDefault f u
 
-testFoldableFoldMapDefaultL :: forall eff. Int -> Eff (assert :: ASSERT | eff) Unit
+testFoldableFoldMapDefaultL :: Int -> EffTest Unit
 testFoldableFoldMapDefaultL = testFoldableFWith (FML <<< arrayFrom1UpTo)
 
-testFoldableFoldMapDefaultR :: forall eff. Int -> Eff (assert :: ASSERT | eff) Unit
+testFoldableFoldMapDefaultR :: Int -> EffTest Unit
 testFoldableFoldMapDefaultR = testFoldableFWith (FMR <<< arrayFrom1UpTo)
 
-testFoldableFoldlDefault :: forall eff. Int -> Eff (assert :: ASSERT | eff) Unit
+testFoldableFoldlDefault :: Int -> EffTest Unit
 testFoldableFoldlDefault = testFoldableFWith (FLD <<< arrayFrom1UpTo)
 
-testFoldableFoldrDefault :: forall eff. Int -> Eff (assert :: ASSERT | eff) Unit
+testFoldableFoldrDefault :: Int -> EffTest Unit
 testFoldableFoldrDefault = testFoldableFWith (FRD <<< arrayFrom1UpTo)
 
 
@@ -217,10 +239,10 @@ instance traversableSD :: Traversable SequenceDefault where
   traverse f (SD a) = map SD (traverse f a)
   sequence m        = sequenceDefault m
 
-testTraverseDefault :: forall eff. Int -> Eff (assert :: ASSERT | eff) Unit
+testTraverseDefault :: Int -> EffTest Unit
 testTraverseDefault = testTraversableFWith (TD <<< arrayFrom1UpTo)
 
-testSequenceDefault :: forall eff. Int -> Eff (assert :: ASSERT | eff) Unit
+testSequenceDefault :: Int -> EffTest Unit
 testSequenceDefault = testTraversableFWith (SD <<< arrayFrom1UpTo)
 
 
@@ -261,10 +283,10 @@ instance bitraversableIOr :: Bitraversable IOr where
   bisequence (Fst fst)      = Fst <$> fst
   bisequence (Snd snd)      = Snd <$> snd
 
-testBifoldableIOrWith :: forall t e. (Bifoldable t, Eq (t Int Int)) =>
+testBifoldableIOrWith :: forall t. (Bifoldable t, Eq (t Int Int)) =>
                          (forall l r. IOr l r -> t l r) ->
                          Int -> Int -> Int ->
-                         Eff (assert :: ASSERT | e) Unit
+                         EffTest Unit
 testBifoldableIOrWith lift fst snd u = do
   assert $ bifoldr (+) (*) u (lift $ Both fst snd) == fst + (snd * u)
   assert $ bifoldr (+) (*) u (lift $ Fst fst)      == fst + u
@@ -278,9 +300,9 @@ testBifoldableIOrWith lift fst snd u = do
   assert $ bifoldMap Additive Additive (lift $ Fst fst)      == Additive fst
   assert $ bifoldMap Additive Additive (lift $ Snd snd)      == Additive snd
 
-testBitraversableIOrWith :: forall t e. (Bitraversable t, Eq (t Boolean Boolean)) =>
+testBitraversableIOrWith :: forall t. (Bitraversable t, Eq (t Boolean Boolean)) =>
                         (forall l r. IOr l r -> t l r) ->
-                        Eff (assert :: ASSERT | e) Unit
+                        EffTest Unit
 testBitraversableIOrWith lift = do
   let just a = Just (lift a)
   assert $ bisequence (lift (Both (Just true) (Just false))) == just (Both true false)