Eliminate toAscList in builder

2 files changed, 17 insertions, 3 deletions

diff --git a/src/Data/BEncode.hs b/src/Data/BEncode.hs
index 6b26ee5..a7c766d 100644
--- a/src/Data/BEncode.hs
+++ b/src/Data/BEncode.hs
@@ -763,10 +763,10 @@ builder = go
                         foldMap go l <>
                         B.word8 (c2w 'e')
       go (BDict    d) = B.word8 (c2w 'd') <>
-                        foldMap mkKV (BD.toAscList d) <>
+                        bifoldMap mkKV d <>
                         B.word8 (c2w 'e')
           where
-            mkKV (k, v) = buildString k <> go v
+            mkKV k v = buildString k <> go v
 
       buildString s = B.intDec (B.length s) <>
                       B.word8 (c2w ':') <>
diff --git a/src/Data/BEncode/BDict.hs b/src/Data/BEncode/BDict.hs
index 2b58644..3bfcd77 100644
--- a/src/Data/BEncode/BDict.hs
+++ b/src/Data/BEncode/BDict.hs
@@ -14,6 +14,7 @@ module Data.BEncode.BDict
 
          -- * Transformations
        , Data.BEncode.BDict.map
+       , Data.BEncode.BDict.bifoldMap
 
          -- * Conversion
        , Data.BEncode.BDict.fromAscList
@@ -22,6 +23,7 @@ module Data.BEncode.BDict
 
 import Control.DeepSeq
 import Data.ByteString as BS
+import Data.Foldable
 import Data.Monoid
 
 
@@ -48,7 +50,12 @@ instance Functor BDictMap where
   fmap = Data.BEncode.BDict.map
   {-# INLINE fmap #-}
 
---instance Foldable BDictMap where
+instance Foldable BDictMap where
+  foldMap f = go
+    where
+      go  Nil          = mempty
+      go (Cons _ v xs) = f v `mappend` go xs
+  {-# INLINE foldMap #-}
 
 instance Monoid (BDictMap a) where
   mempty  = Data.BEncode.BDict.empty
@@ -81,6 +88,13 @@ map f = go
     go (Cons k v xs) = Cons k (f v) (go xs)
 {-# INLINE map #-}
 
+bifoldMap :: Monoid m => (BKey -> a -> m) -> BDictMap a -> m
+bifoldMap f = go
+  where
+    go  Nil          = mempty
+    go (Cons k v xs) = f k v `mappend` go xs
+{-# INLINE bifoldMap #-}
+
 fromAscList :: [(BKey, a)] -> BDictMap a
 fromAscList [] = Nil
 fromAscList ((k, v) : xs) = Cons k v (fromAscList xs)