Add instance Bifoldable HashMap (#251)

Author: josephcsible

Data/HashMap/Base.hs

@@ -131,6 +131,9 @@ import Control.Monad.ST (ST)
 import Data.Bits ((.&.), (.|.), complement, popCount)
 import Data.Data hiding (Typeable)
 import qualified Data.Foldable as Foldable
+#if MIN_VERSION_base(4,10,0)
+import Data.Bifoldable
+#endif
 import qualified Data.List as L
 import GHC.Exts ((==#), build, reallyUnsafePtrEquality#)
 import Prelude hiding (filter, foldl, foldr, lookup, map, null, pred)
@@ -222,6 +225,17 @@ instance Foldable.Foldable (HashMap k) where
     {-# INLINE length #-}
 #endif
 
+#if MIN_VERSION_base(4,10,0)
+-- | @since UNRELEASED
+instance Bifoldable HashMap where
+    bifoldMap f g = foldMapWithKey (\ k v -> f k `mappend` g v)
+    {-# INLINE bifoldMap #-}
+    bifoldr f g = foldrWithKey (\ k v acc -> k `f` (v `g` acc))
+    {-# INLINE bifoldr #-}
+    bifoldl f g = foldlWithKey (\ acc k v -> (acc `f` k) `g` v)
+    {-# INLINE bifoldl #-}
+#endif
+
 #if __GLASGOW_HASKELL__ >= 711
 -- | '<>' = 'union'
 --

tests/HashMapProperties.hs

@@ -7,6 +7,9 @@ module Main (main) where
 
 import Control.Monad ( guard )
 import qualified Data.Foldable as Foldable
+#if MIN_VERSION_base(4,10,0)
+import Data.Bifoldable
+#endif
 import Data.Function (on)
 import Data.Hashable (Hashable(hashWithSalt))
 import qualified Data.List as L
@@ -291,6 +294,23 @@ pFoldr = (L.sort . M.foldr (:) []) `eq` (L.sort . HM.foldr (:) [])
 pFoldl :: [(Int, Int)] -> Bool
 pFoldl = (L.sort . M.foldl (flip (:)) []) `eq` (L.sort . HM.foldl (flip (:)) [])
 
+#if MIN_VERSION_base(4,10,0)
+pBifoldMap :: [(Int, Int)] -> Bool
+pBifoldMap xs = concatMap f (HM.toList m) == bifoldMap (:[]) (:[]) m
+  where f (k, v) = [k, v]
+        m = HM.fromList xs
+
+pBifoldr :: [(Int, Int)] -> Bool
+pBifoldr xs = concatMap f (HM.toList m) == bifoldr (:) (:) [] m
+  where f (k, v) = [k, v]
+        m = HM.fromList xs
+
+pBifoldl :: [(Int, Int)] -> Bool
+pBifoldl xs = reverse (concatMap f $ HM.toList m) == bifoldl (flip (:)) (flip (:)) [] m
+  where f (k, v) = [k, v]
+        m = HM.fromList xs
+#endif
+
 pFoldrWithKey :: [(Int, Int)] -> Bool
 pFoldrWithKey = (sortByKey . M.foldrWithKey f []) `eq`
                 (sortByKey . HM.foldrWithKey f [])
@@ -414,6 +434,11 @@ tests =
     , testGroup "folds"
       [ testProperty "foldr" pFoldr
       , testProperty "foldl" pFoldl
+#if MIN_VERSION_base(4,10,0)
+      , testProperty "bifoldMap" pBifoldMap
+      , testProperty "bifoldr" pBifoldr
+      , testProperty "bifoldl" pBifoldl
+#endif
       , testProperty "foldrWithKey" pFoldrWithKey
       , testProperty "foldlWithKey" pFoldlWithKey
       , testProperty "foldrWithKey'" pFoldrWithKey'