Default impls for Foldable & Traversable methods

[Ticket #27](#27)

Functions added:

* foldMapDefaultL
* foldMapDefaultR
* foldlDefault
* foldrDefault
* traverseDefault
* sequenceDefault

Added tests for each new function.

Plus regenerated docs.

Author: LiamGoodacre

docs/Data/Foldable.md

@@ -28,6 +28,38 @@ instance foldableConj :: Foldable Conj
 instance foldableMultiplicative :: Foldable Multiplicative
 ```
 
+#### `foldrDefault`
+
+``` purescript
+foldrDefault :: forall f a b. (Foldable f) => (a -> b -> b) -> b -> f a -> b
+```
+
+A default implementation of `foldr` using `foldMap`
+
+#### `foldlDefault`
+
+``` purescript
+foldlDefault :: forall f a b. (Foldable f) => (b -> a -> b) -> b -> f a -> b
+```
+
+A default implementation of `foldl` using `foldMap`
+
+#### `foldMapDefaultL`
+
+``` purescript
+foldMapDefaultL :: forall f a m. (Foldable f, Monoid m) => (a -> m) -> f a -> m
+```
+
+A default implementation of `foldMap` using `foldl`
+
+#### `foldMapDefaultR`
+
+``` purescript
+foldMapDefaultR :: forall f a m. (Foldable f, Monoid m) => (a -> m) -> f a -> m
+```
+
+A default implementation of `foldMap` using `foldr`
+
 #### `fold`
 
 ``` purescript

docs/Data/Traversable.md

@@ -40,6 +40,22 @@ instance traversableDisj :: Traversable Disj
 instance traversableMultiplicative :: Traversable Multiplicative
 ```
 
+#### `traverseDefault`
+
+``` purescript
+traverseDefault :: forall t a b m. (Traversable t, Applicative m) => (a -> m b) -> t a -> m (t b)
+```
+
+A default implementation of `traverse` using `sequence` and `map`
+
+#### `sequenceDefault`
+
+``` purescript
+sequenceDefault :: forall t a m. (Traversable t, Applicative m) => t (m a) -> m (t a)
+```
+
+A default implementation of `sequence` using `traverse`
+
 #### `for`
 
 ``` purescript

src/Data/Foldable.purs

@@ -1,5 +1,6 @@
 module Data.Foldable
   ( Foldable, foldr, foldl, foldMap
+  , foldrDefault, foldlDefault, foldMapDefaultL, foldMapDefaultR
   , fold
   , traverse_
   , for_
@@ -25,7 +26,8 @@ import Data.Maybe.First (First(..), runFirst)
 import Data.Maybe.Last (Last(..))
 import Data.Monoid (Monoid, mempty)
 import Data.Monoid.Additive (Additive(..))
-import Data.Monoid.Dual (Dual(..))
+import Data.Monoid.Dual (Dual(..), runDual)
+import Data.Monoid.Endo (Endo(..), runEndo)
 import Data.Monoid.Disj (Disj(..), runDisj)
 import Data.Monoid.Conj (Conj(..), runConj)
 import Data.Monoid.Multiplicative (Multiplicative(..))
@@ -40,10 +42,32 @@ class Foldable f where
   foldl :: forall a b. (b -> a -> b) -> b -> f a -> b
   foldMap :: forall a m. (Monoid m) => (a -> m) -> f a -> m
 
+
+-- | A default implementation of `foldr` using `foldMap`
+foldrDefault :: forall f a b. (Foldable f) =>
+                (a -> b -> b) -> b -> f a -> b
+foldrDefault c u xs = runEndo (foldMap (Endo <<< c) xs) u
+
+-- | A default implementation of `foldl` using `foldMap`
+foldlDefault :: forall f a b. (Foldable f) =>
+                (b -> a -> b) -> b -> f a -> b
+foldlDefault c u xs = runEndo (runDual (foldMap (Dual <<< Endo <<< flip c) xs)) u
+
+-- | A default implementation of `foldMap` using `foldl`
+foldMapDefaultL :: forall f a m. (Foldable f, Monoid m) =>
+                   (a -> m) -> f a -> m
+foldMapDefaultL f xs = foldl (\acc x -> f x <> acc) mempty xs
+
+-- | A default implementation of `foldMap` using `foldr`
+foldMapDefaultR :: forall f a m. (Foldable f, Monoid m) =>
+                   (a -> m) -> f a -> m
+foldMapDefaultR f xs = foldr (\x acc -> f x <> acc) mempty xs
+
+
 instance foldableArray :: Foldable Array where
-  foldr = foldrArray
-  foldl = foldlArray
-  foldMap f xs = foldr (\x acc -> f x <> acc) mempty xs
+  foldr   = foldrArray
+  foldl   = foldlArray
+  foldMap = foldMapDefaultR
 
 foreign import foldrArray :: forall a b. (a -> b -> b) -> b -> Array a -> b
 foreign import foldlArray :: forall a b. (b -> a -> b) -> b -> Array a -> b

src/Data/Traversable.purs

@@ -1,7 +1,6 @@
 module Data.Traversable
-  ( Traversable
-  , traverse
-  , sequence
+  ( Traversable, traverse, sequence
+  , traverseDefault, sequenceDefault
   , for
   , Accum()
   , scanl
@@ -44,6 +43,16 @@ class (Functor t, Foldable t) <= Traversable t where
   traverse :: forall a b m. (Applicative m) => (a -> m b) -> t a -> m (t b)
   sequence :: forall a m. (Applicative m) => t (m a) -> m (t a)
 
+
+-- | A default implementation of `traverse` using `sequence` and `map`
+traverseDefault :: forall t a b m. (Traversable t, Applicative m) => (a -> m b) -> t a -> m (t b)
+traverseDefault f ta = sequence (map f ta)
+
+-- | A default implementation of `sequence` using `traverse`
+sequenceDefault :: forall t a m. (Traversable t, Applicative m) => t (m a) -> m (t a)
+sequenceDefault tma = traverse id tma
+
+
 foreign import traverseArrayImpl
   :: forall m a b. (m (a -> b) -> m a -> m b) ->
                    ((a -> b) -> m a -> m b) ->
@@ -54,7 +63,7 @@ foreign import traverseArrayImpl
 
 instance traversableArray :: Traversable Array where
   traverse = traverseArrayImpl apply map pure
-  sequence = traverse id
+  sequence = sequenceDefault
 
 instance traversableMaybe :: Traversable Maybe where
   traverse _ Nothing  = pure Nothing

test/Main.purs

@@ -1,8 +1,8 @@
-
 module Test.Main where
 
 import Prelude
 
+import Control.Monad.Eff (Eff())
 import Control.Monad.Eff.Console
 import Data.Foldable
 import Data.Maybe
@@ -14,30 +14,133 @@ foreign import arrayFrom1UpTo :: Int -> Array Int
 
 main = do
   log "Test foldableArray instance"
-  testFoldableWith 20
+  testFoldableArrayWith 20
 
   log "Test traversableArray instance"
-  testTraversableWith 20
+  testTraversableArrayWith 20
 
   log "Test foldableArray instance is stack safe"
-  testFoldableWith 20000
+  testFoldableArrayWith 20000
 
   log "Test traversableArray instance is stack safe"
-  testTraversableWith 20000
+  testTraversableArrayWith 20000
+
+  log "Test foldMapDefaultL"
+  testFoldableFoldMapDefaultL 20
+
+  log "Test foldMapDefaultR"
+  testFoldableFoldMapDefaultR 20
+
+  log "Test foldlDefault"
+  testFoldableFoldlDefault 20
+
+  log "Test foldrDefault"
+  testFoldableFoldlDefault 20
+
+  log "Test traverseDefault"
+  testTraverseDefault 20
+
+  log "Test sequenceDefault"
+  testSequenceDefault 20
 
   log "All done!"
 
-testFoldableWith n = do
-  let arr = arrayFrom1UpTo n
+
+testFoldableFWith :: forall f e. (Foldable f, Eq (f Int)) => (Int -> f Int) -> Int -> Eff (assert :: ASSERT | e) Unit
+testFoldableFWith f n = do
+  let arr = f n
   let expectedSum = (n / 2) * (n + 1)
 
   assert $ foldr (+) 0 arr == expectedSum
   assert $ foldl (+) 0 arr == expectedSum
   assert $ foldMap Additive arr == Additive expectedSum
 
-testTraversableWith n = do
-  let arr = arrayFrom1UpTo n
+testFoldableArrayWith = testFoldableFWith arrayFrom1UpTo
+
+
+testTraversableFWith :: forall f e. (Traversable f, Eq (f Int)) => (Int -> f Int) -> Int -> Eff (assert :: ASSERT | e) Unit
+testTraversableFWith f n = do
+  let arr = f n
 
   assert $ traverse Just arr == Just arr
   assert $ traverse return arr == [arr]
   assert $ traverse (\x -> if x < 10 then Just x else Nothing) arr == Nothing
+  assert $ sequence (map Just arr) == traverse Just arr
+
+testTraversableArrayWith = testTraversableFWith arrayFrom1UpTo
+
+
+-- structures for testing default `Foldable` implementations
+
+newtype FoldMapDefaultL a = FML (Array a)
+newtype FoldMapDefaultR a = FMR (Array a)
+newtype FoldlDefault    a = FLD (Array a)
+newtype FoldrDefault    a = FRD (Array a)
+
+instance eqFML :: (Eq a) => Eq (FoldMapDefaultL a) where eq (FML l) (FML r) = l == r
+instance eqFMR :: (Eq a) => Eq (FoldMapDefaultR a) where eq (FMR l) (FMR r) = l == r
+instance eqFLD :: (Eq a) => Eq (FoldlDefault a)    where eq (FLD l) (FLD r) = l == r
+instance eqFRD :: (Eq a) => Eq (FoldrDefault a)    where eq (FRD l) (FRD r) = l == r
+
+-- implemented `foldl` and `foldr`, but default `foldMap` using `foldl`
+instance foldableFML :: Foldable FoldMapDefaultL where
+  foldMap f         = foldMapDefaultL f
+  foldl f u (FML a) = foldl f u a
+  foldr f u (FML a) = foldr f u a
+
+-- implemented `foldl` and `foldr`, but default `foldMap`, using `foldr`
+instance foldableFMR :: Foldable FoldMapDefaultR where
+  foldMap f         = foldMapDefaultR f
+  foldl f u (FMR a) = foldl f u a
+  foldr f u (FMR a) = foldr f u a
+
+-- implemented `foldMap` and `foldr`, but default `foldMap`
+instance foldableDFL :: Foldable FoldlDefault where
+  foldMap f (FLD a) = foldMap f a
+  foldl f u         = foldlDefault f u
+  foldr f u (FLD a) = foldr f u a
+
+-- implemented `foldMap` and `foldl`, but default `foldr`
+instance foldableDFR :: Foldable FoldrDefault where
+  foldMap f (FRD a) = foldMap f a
+  foldl f u (FRD a) = foldl f u a
+  foldr f u         = foldrDefault f u
+
+testFoldableFoldMapDefaultL = testFoldableFWith (FML <<< arrayFrom1UpTo)
+testFoldableFoldMapDefaultR = testFoldableFWith (FMR <<< arrayFrom1UpTo)
+testFoldableFoldlDefault    = testFoldableFWith (FLD <<< arrayFrom1UpTo)
+testFoldableFoldrDefault    = testFoldableFWith (FRD <<< arrayFrom1UpTo)
+
+
+-- structures for testing default `Traversable` implementations
+
+newtype TraverseDefault a = TD (Array a)
+newtype SequenceDefault a = SD (Array a)
+
+instance eqTD :: (Eq a) => Eq (TraverseDefault a) where eq (TD l) (TD r) = l == r
+instance eqSD :: (Eq a) => Eq (SequenceDefault a) where eq (SD l) (SD r) = l == r
+
+instance functorTD :: Functor TraverseDefault where map f (TD a) = TD (map f a)
+instance functorSD :: Functor SequenceDefault where map f (SD a) = SD (map f a)
+
+instance foldableTD :: Foldable TraverseDefault where
+  foldMap f (TD a) = foldMap f a
+  foldr f u (TD a) = foldr f u a
+  foldl f u (TD a) = foldl f u a
+
+instance foldableSD :: Foldable SequenceDefault where
+  foldMap f (SD a) = foldMap f a
+  foldr f u (SD a) = foldr f u a
+  foldl f u (SD a) = foldl f u a
+
+instance traversableTD :: Traversable TraverseDefault where
+  traverse f      = traverseDefault f
+  sequence (TD a) = map TD (sequence a)
+
+instance traversableSD :: Traversable SequenceDefault where
+  traverse f (SD a) = map SD (traverse f a)
+  sequence m        = sequenceDefault m
+
+testTraverseDefault = testTraversableFWith (TD <<< arrayFrom1UpTo)
+testSequenceDefault = testTraversableFWith (SD <<< arrayFrom1UpTo)
+