Merge pull request #55 from hdgarrood/from-foldable

Add fromFoldable

Author: garyb

.jshintrc

@@ -7,7 +7,6 @@
   "futurehostile": true,
   "strict": "global",
   "latedef": true,
-  "maxparams": 1,
   "noarg": true,
   "nocomma": true,
   "nonew": true,

src/Data/Array.js

@@ -28,6 +28,36 @@ exports.replicate = function (n) {
   };
 };
 
+exports.fromFoldableImpl = (function () {
+  function Cons (head, tail) {
+    this.head = head;
+    this.tail = tail;
+  }
+  var emptyList = {};
+
+  function curryCons (head) {
+    return function (tail) {
+      return new Cons(head, tail);
+    };
+  }
+
+  function listToArray (list) {
+    var result = [];
+    var count = 0;
+    while (list !== emptyList) {
+      result[count++] = list.head;
+      list = list.tail;
+    }
+    return result;
+  }
+
+  return function (foldr) {
+    return function (xs) {
+      return listToArray(foldr(curryCons)(emptyList)(xs));
+    };
+  };
+})();
+
 //------------------------------------------------------------------------------
 // Array size ------------------------------------------------------------------
 //------------------------------------------------------------------------------
@@ -195,7 +225,6 @@ exports.partition = function (f) {
 
 exports.sortImpl = function (f) {
   return function (l) {
-    /* jshint maxparams: 2 */
     return l.slice().sort(function (x, y) {
       return f(x)(y);
     });

src/Data/Array.purs

@@ -34,6 +34,7 @@ module Data.Array
   , replicateM
   , some
   , many
+  , fromFoldable
 
   , null
   , length
@@ -107,7 +108,7 @@ import Control.Alt ((<|>))
 import Control.Alternative (class Alternative)
 import Control.Lazy (class Lazy, defer)
 
-import Data.Foldable (foldl)
+import Data.Foldable (class Foldable, foldl, foldr)
 import Data.Maybe (Maybe(..), maybe, isJust, fromJust)
 import Data.Traversable (sequence)
 import Data.Tuple (Tuple(..))
@@ -148,6 +149,12 @@ some v = (:) <$> v <*> defer (\_ -> many v)
 many :: forall f a. (Alternative f, Lazy (f (Array a))) => f a -> f (Array a)
 many v = some v <|> pure []
 
+-- | Construct an `Array` from any `Foldable` structure.
+fromFoldable :: forall f a. (Foldable f) => f a -> Array a
+fromFoldable = fromFoldableImpl foldr
+
+foreign import fromFoldableImpl :: forall f a. (forall b. (a -> b -> b) -> b -> f a -> b) -> f a -> Array a
+
 --------------------------------------------------------------------------------
 -- Array size ------------------------------------------------------------------
 --------------------------------------------------------------------------------

test/Test/Data/Array.purs

@@ -4,8 +4,10 @@ import Prelude
 
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (log, CONSOLE)
+import Data.Foldable (for_, foldMapDefaultR, class Foldable, all)
+import Test.Assert (assert)
 
-import Data.Array (range, foldM, unzip, zip, zipWithA, zipWith, intersectBy, intersect, (\\), deleteBy, delete, unionBy, union, nubBy, nub, groupBy, group', group, span, dropWhile, drop, takeWhile, take, sortBy, sort, catMaybes, mapMaybe, filterM, filter, concat, concatMap, reverse, alterAt, modifyAt, updateAt, deleteAt, insertAt, findLastIndex, findIndex, elemLastIndex, elemIndex, (!!), uncons, init, tail, last, head, insertBy, insert, snoc, (:), length, null, replicate, replicateM, singleton)
+import Data.Array (range, foldM, unzip, zip, zipWithA, zipWith, intersectBy, intersect, (\\), deleteBy, delete, unionBy, union, nubBy, nub, groupBy, group', group, span, dropWhile, drop, takeWhile, take, sortBy, sort, catMaybes, mapMaybe, filterM, filter, concat, concatMap, reverse, alterAt, modifyAt, updateAt, deleteAt, insertAt, findLastIndex, findIndex, elemLastIndex, elemIndex, (!!), uncons, init, tail, last, head, insertBy, insert, snoc, (:), length, null, replicate, replicateM, singleton, fromFoldable)
 import Data.Maybe (Maybe(..), isNothing, fromJust)
 import Data.Tuple (Tuple(..))
 
@@ -44,8 +46,8 @@ testArray = do
   assert $ replicateM (-1) (Just 1) == Just []
 
   log "replicateM should be stack safe"
-  let n = 50000
-  assert $ replicateM n (Just unit) == Just (replicate n unit)
+  for_ [1, 1000, 2000, 20000, 50000] \n -> do
+    assert $ replicateM n (Just unit) == Just (replicate n unit)
 
   -- some
   -- many
@@ -292,6 +294,17 @@ testArray = do
   assert $ foldM (\x y -> Just (x + y)) 0 (range 1 10) == Just 55
   assert $ foldM (\_ _ -> Nothing) 0 (range 1 10) == Nothing
 
+  log "fromFoldable"
+  for_ [[], [1], [1,2], [1,2,3,4,5]] \xs -> do
+    assert $ fromFoldable xs == xs
+
+  log "fromFoldable is stack safe"
+  for_ [1, 1000, 10000, 20000, 50000] \n -> do
+    let elem = 0
+    let arr = fromFoldable (Replicated n elem)
+    assert $ length arr == n
+    assert $ all (_ == elem) arr
+
 nil :: Array Int
 nil = []
 
@@ -300,3 +313,15 @@ odd n = n `mod` 2 /= zero
 
 doubleAndOrig :: Int -> Array Int
 doubleAndOrig x = [x * 2, x]
+
+data Replicated a = Replicated Int a
+
+instance foldableReplicated :: Foldable Replicated where
+  foldr f z (Replicated n x) = applyN n (f x) z
+  foldl f z (Replicated n x) = applyN n (flip f x) z
+  foldMap = foldMapDefaultR
+
+applyN :: forall a. Int -> (a -> a) -> a -> a
+applyN n f x
+  | n <= 0    = x
+  | otherwise = applyN (n - 1) f (f x)