summaryrefslogtreecommitdiff
path: root/src/Data/BEncode/BDict.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/BEncode/BDict.hs')
-rw-r--r--src/Data/BEncode/BDict.hs16
1 files changed, 15 insertions, 1 deletions
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
14 14
15 -- * Transformations 15 -- * Transformations
16 , Data.BEncode.BDict.map 16 , Data.BEncode.BDict.map
17 , Data.BEncode.BDict.bifoldMap
17 18
18 -- * Conversion 19 -- * Conversion
19 , Data.BEncode.BDict.fromAscList 20 , Data.BEncode.BDict.fromAscList
@@ -22,6 +23,7 @@ module Data.BEncode.BDict
22 23
23import Control.DeepSeq 24import Control.DeepSeq
24import Data.ByteString as BS 25import Data.ByteString as BS
26import Data.Foldable
25import Data.Monoid 27import Data.Monoid
26 28
27 29
@@ -48,7 +50,12 @@ instance Functor BDictMap where
48 fmap = Data.BEncode.BDict.map 50 fmap = Data.BEncode.BDict.map
49 {-# INLINE fmap #-} 51 {-# INLINE fmap #-}
50 52
51--instance Foldable BDictMap where 53instance Foldable BDictMap where
54 foldMap f = go
55 where
56 go Nil = mempty
57 go (Cons _ v xs) = f v `mappend` go xs
58 {-# INLINE foldMap #-}
52 59
53instance Monoid (BDictMap a) where 60instance Monoid (BDictMap a) where
54 mempty = Data.BEncode.BDict.empty 61 mempty = Data.BEncode.BDict.empty
@@ -81,6 +88,13 @@ map f = go
81 go (Cons k v xs) = Cons k (f v) (go xs) 88 go (Cons k v xs) = Cons k (f v) (go xs)
82{-# INLINE map #-} 89{-# INLINE map #-}
83 90
91bifoldMap :: Monoid m => (BKey -> a -> m) -> BDictMap a -> m
92bifoldMap f = go
93 where
94 go Nil = mempty
95 go (Cons k v xs) = f k v `mappend` go xs
96{-# INLINE bifoldMap #-}
97
84fromAscList :: [(BKey, a)] -> BDictMap a 98fromAscList :: [(BKey, a)] -> BDictMap a
85fromAscList [] = Nil 99fromAscList [] = Nil
86fromAscList ((k, v) : xs) = Cons k v (fromAscList xs) 100fromAscList ((k, v) : xs) = Cons k v (fromAscList xs)