{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
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.mapWithKey
, Data.BEncode.BDict.foldMapWithKey
, Data.BEncode.BDict.bifoldMap
, Data.BEncode.BDict.fromAscList
, Data.BEncode.BDict.toAscList
) where
import Control.DeepSeq
import Data.ByteString as BS
#if __GLASGOW_HASKELL__ < 710
import Data.Foldable
import Data.Monoid (Monoid (mappend, mempty))
#endif
#if __GLASGOW_HASKELL__ < 808
import Data.Semigroup (Semigroup ((<>)))
#endif
import GHC.Generics (Generic)
type BKey = ByteString
data BDictMap a
= Cons !BKey a !(BDictMap a)
| Nil
deriving (Show, Read, Eq, Ord, Generic)
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
{-# INLINE fmap #-}
instance Foldable BDictMap where
foldMap f = go
where
go Nil = mempty
go (Cons _ v xs) = f v `mappend` go xs
{-# INLINE foldMap #-}
instance Semigroup (BDictMap a) where
(<>) = Data.BEncode.BDict.union
instance Monoid (BDictMap a) where
mempty = Data.BEncode.BDict.empty
mappend = (<>)
empty :: BDictMap a
empty = Nil
{-# INLINE empty #-}
singleton :: BKey -> a -> BDictMap a
singleton k v = Cons k v Nil
{-# INLINE singleton #-}
null :: BDictMap a -> Bool
null Nil = True
null _ = False
{-# INLINE null #-}
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
{-# INLINE lookup #-}
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)
{-# INLINE map #-}
mapWithKey :: (BKey -> a -> b) -> BDictMap a -> BDictMap b
mapWithKey f = go
where
go Nil = Nil
go (Cons k v xs) = Cons k (f k v) (go xs)
{-# INLINE mapWithKey #-}
foldMapWithKey :: Monoid m => (BKey -> a -> m) -> BDictMap a -> m
foldMapWithKey f = go
where
go Nil = mempty
go (Cons k v xs) = f k v `mappend` go xs
{-# INLINE foldMapWithKey #-}
{-# DEPRECATED bifoldMap "Use foldMapWithKey instead" #-}
bifoldMap :: Monoid m => (BKey -> a -> m) -> BDictMap a -> m
bifoldMap = foldMapWithKey
{-# INLINE bifoldMap #-}
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