Add monoid instances

Author: garyb

src/Data/Foldable.purs

@@ -4,7 +4,11 @@ import Control.Apply
 import Data.Either
 import Data.Maybe
 import Data.Monoid
+import Data.Monoid.Additive
+import Data.Monoid.Dual
 import Data.Monoid.First
+import Data.Monoid.Last
+import Data.Monoid.Multiplicative
 import Data.Tuple
 
 class Foldable f where
@@ -14,38 +18,55 @@ class Foldable f where
 
 instance foldableArray :: Foldable [] where
   foldr f z xs = foldrArray f z xs
-
   foldl f z xs = foldlArray f z xs
-
   foldMap f xs = foldr (\x acc -> f x <> acc) mempty xs
 
 instance foldableEither :: Foldable (Either a) where
   foldr _ z (Left _)  = z
   foldr f z (Right x) = x `f` z
-
   foldl _ z (Left _)  = z
   foldl f z (Right x) = z `f` x
-
   foldMap f (Left _)  = mempty
   foldMap f (Right x) = f x
 
 instance foldableMaybe :: Foldable Maybe where
   foldr _ z Nothing  = z
   foldr f z (Just x) = x `f` z
-
   foldl _ z Nothing  = z
   foldl f z (Just x) = z `f` x
-
   foldMap f Nothing  = mempty
   foldMap f (Just x) = f x
 
 instance foldableTuple :: Foldable (Tuple a) where
   foldr f z (Tuple _ x) = x `f` z
-
   foldl f z (Tuple _ x) = z `f` x
-
   foldMap f (Tuple _ x) = f x
 
+instance foldableAdditive :: Foldable Additive where
+  foldr f z (Additive x) = x `f` z
+  foldl f z (Additive x) = z `f` x
+  foldMap f (Additive x) = f x
+
+instance foldableDual :: Foldable Dual where
+  foldr f z (Dual x) = x `f` z
+  foldl f z (Dual x) = z `f` x
+  foldMap f (Dual x) = f x
+
+instance foldableFirst :: Foldable First where
+  foldr f z (First x) = foldr f z x
+  foldl f z (First x) = foldl f z x
+  foldMap f (First x) = foldMap f x
+
+instance foldableLast :: Foldable Last where
+  foldr f z (Last x) = foldr f z x
+  foldl f z (Last x) = foldl f z x
+  foldMap f (Last x) = foldMap f x
+
+instance foldableMultiplicative :: Foldable Multiplicative where
+  foldr f z (Multiplicative x) = x `f` z
+  foldl f z (Multiplicative x) = z `f` x
+  foldMap f (Multiplicative x) = f x
+
 fold :: forall f m. (Foldable f, Monoid m) => f m -> m
 fold = foldMap id
 
@@ -99,7 +120,8 @@ find p f = case foldMap (\x -> if p x then [x] else []) f of
 lookup :: forall a b f. (Eq a, Foldable f) => a -> f (Tuple a b) -> Maybe b
 lookup a f = runFirst $ foldMap (\(Tuple a' b) -> First (if a == a' then Just b else Nothing)) f
 
-foreign import foldrArray """
+foreign import foldrArray
+  """
   function foldrArray(f) {
     return function(z) {
       return function(xs) {
@@ -108,11 +130,13 @@ foreign import foldrArray """
           acc = f(xs[i])(acc);
         }
         return acc;
-      }
-    }
-  }""" :: forall a b. (a -> b -> b) -> b -> [a] -> b
+      };
+    };
+  }
+  """ :: forall a b. (a -> b -> b) -> b -> [a] -> b
 
-foreign import foldlArray """
+foreign import foldlArray
+  """
   function foldlArray(f) {
     return function(z) {
       return function(xs) {
@@ -121,6 +145,7 @@ foreign import foldlArray """
           acc = f(acc)(xs[i]);
         }
         return acc;
-      }
-    }
-  }""" :: forall a b. (b -> a -> b) -> b -> [a] -> b
+      };
+    };
+  }
+  """ :: forall a b. (b -> a -> b) -> b -> [a] -> b

src/Data/Traversable.purs

@@ -14,6 +14,11 @@ import Data.Array (zipWith)
 import Data.Either
 import Data.Foldable
 import Data.Maybe
+import Data.Monoid.Additive
+import Data.Monoid.Dual
+import Data.Monoid.First
+import Data.Monoid.Last
+import Data.Monoid.Multiplicative
 import Data.Tuple
 
 class (Functor t, Foldable t) <= Traversable t where
@@ -23,29 +28,45 @@ class (Functor t, Foldable t) <= Traversable t where
 instance traversableArray :: Traversable [] where
   traverse _ []     = pure []
   traverse f (x:xs) = (:) <$> (f x) <*> traverse f xs
-
   sequence []     = pure []
   sequence (x:xs) = (:) <$> x <*> sequence xs
 
 instance traversableEither :: Traversable (Either a) where
   traverse _ (Left x)  = pure (Left x)
   traverse f (Right x) = Right <$> f x
-
   sequence (Left x) = pure (Left x)
   sequence (Right x)  = Right <$> x
 
 instance traversableMaybe :: Traversable Maybe where
   traverse _ Nothing  = pure Nothing
   traverse f (Just x) = Just <$> f x
-
   sequence Nothing  = pure Nothing
   sequence (Just x) = Just <$> x
 
 instance traversableTuple :: Traversable (Tuple a) where
   traverse f (Tuple x y) = Tuple x <$> f y
-
   sequence (Tuple x y) = Tuple x <$> y
 
+instance traversableAdditive :: Traversable Additive where
+  traverse f (Additive x) = Additive <$> f x
+  sequence (Additive x) = Additive <$> x
+
+instance traversableDual :: Traversable Dual where
+  traverse f (Dual x) = Dual <$> f x
+  sequence (Dual x) = Dual <$> x
+
+instance traversableFirst :: Traversable First where
+  traverse f (First x) = First <$> traverse f x
+  sequence (First x) = First <$> sequence x
+
+instance traversableLast :: Traversable Last where
+  traverse f (Last x) = Last <$> traverse f x
+  sequence (Last x) = Last <$> sequence x
+
+instance traversableMultiplicative :: Traversable Multiplicative where
+  traverse f (Multiplicative x) = Multiplicative <$> f x
+  sequence (Multiplicative x) = Multiplicative <$> x
+
 for :: forall a b m t. (Applicative m, Traversable t) => t a -> (a -> m b) -> m (t b)
 for x f = traverse f x
 
@@ -97,4 +118,3 @@ scanr f b0 xs = snd $ mapAccumR (\b a -> let b' = f a b in Tuple b' b') b0 xs
 
 mapAccumR :: forall a b s f. (Traversable f) => (s -> a -> Tuple s b) -> s -> f a -> Tuple s (f b)
 mapAccumR f s0 xs = stateR (traverse (\a -> StateR $ \s -> f s a) xs) s0
-