module Data.BEncode.BDict
( BKey
, BDictMap (..)
, Data.BEncode.BDict.empty
, Data.BEncode.BDict.singleton
, Data.BEncode.BDict.null
, Data.BEncode.BDict.member
, Data.BEncode.BDict.lookup
, Data.BEncode.BDict.union
, Data.BEncode.BDict.map
, Data.BEncode.BDict.bifoldMap
, Data.BEncode.BDict.fromAscList
, Data.BEncode.BDict.toAscList
) where
import Control.DeepSeq
import Data.ByteString as BS
import Data.Foldable
import Data.Monoid
type BKey = ByteString
data BDictMap a
= Cons !BKey a !(BDictMap a)
| Nil
deriving (Show, Read, Eq, Ord)
instance NFData a => NFData (BDictMap a) where
rnf Nil = ()
rnf (Cons _ v xs)= rnf v `seq` rnf xs
instance Functor BDictMap where
fmap = Data.BEncode.BDict.map
instance Foldable BDictMap where
foldMap f = go
where
go Nil = mempty
go (Cons _ v xs) = f v `mappend` go xs
instance Monoid (BDictMap a) where
mempty = Data.BEncode.BDict.empty
mappend = Data.BEncode.BDict.union
empty :: BDictMap a
empty = Nil
singleton :: BKey -> a -> BDictMap a
singleton k v = Cons k v Nil
null :: BDictMap a -> Bool
null Nil = True
null _ = False
member :: BKey -> BDictMap a -> Bool
member key = go
where
go Nil = False
go (Cons k _ xs)
| k == key = True
| otherwise = go xs
lookup :: BKey -> BDictMap a -> Maybe a
lookup x = go
where
go Nil = Nothing
go (Cons k v xs)
| k == x = Just v
| otherwise = go xs
union :: BDictMap a -> BDictMap a -> BDictMap a
union Nil xs = xs
union xs Nil = xs
union bd @ (Cons k v xs) bd' @ (Cons k' v' xs')
| k < k' = Cons k v (union xs bd')
| otherwise = Cons k' v' (union bd xs')
map :: (a -> b) -> BDictMap a -> BDictMap b
map f = go
where
go Nil = Nil
go (Cons k v xs) = Cons k (f v) (go xs)
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
fromAscList :: [(BKey, a)] -> BDictMap a
fromAscList [] = Nil
fromAscList ((k, v) : xs) = Cons k v (fromAscList xs)
toAscList :: BDictMap a -> [(BKey, a)]
toAscList Nil = []
toAscList (Cons k v xs) = (k, v) : toAscList xs