1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
-- |
-- Copyright : (c) Sam Truzjan 2013
-- License : BSD3
-- Maintainer : pxqr.sta@gmail.com
-- Stability : stable
-- Portability : portable
--
-- This module defines a simple key\/value list ordered by keys
-- which both faster and more suitable for bencode dictionaries than
-- just [(k,v)].
--
module Data.BEncode.BDict
( BKey
, BDictMap (..)
-- * Construction
, Data.BEncode.BDict.empty
, Data.BEncode.BDict.singleton
-- * Query
, Data.BEncode.BDict.null
, Data.BEncode.BDict.member
, Data.BEncode.BDict.lookup
-- * Combine
, Data.BEncode.BDict.union
-- * Traversal
, Data.BEncode.BDict.map
, Data.BEncode.BDict.bifoldMap
-- * Conversion
, 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
-- STRICTNESS NOTE: the BKey is always evaluated since we either use a
-- literal or compare before insert to the dict
--
-- LAYOUT NOTE: we don't use [StrictPair BKey a] since it introduce
-- one more constructor per cell
--
-- | BDictMap is an ascending list of key\/value pairs sorted by keys.
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
{-# 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 Monoid (BDictMap a) where
mempty = Data.BEncode.BDict.empty
mappend = Data.BEncode.BDict.union
-- | /O(1)/. The empty dicionary.
empty :: BDictMap a
empty = Nil
{-# INLINE empty #-}
-- | /O(1)/. Dictionary of one key-value pair.
singleton :: BKey -> a -> BDictMap a
singleton k v = Cons k v Nil
{-# INLINE singleton #-}
-- | /O(1)/. Is the dictionary empty?
null :: BDictMap a -> Bool
null Nil = True
null _ = False
{-# INLINE null #-}
-- | /O(n)/. Is the key a member of the dictionary?
member :: BKey -> BDictMap a -> Bool
member key = go
where
go Nil = False
go (Cons k _ xs)
| k == key = True
| otherwise = go xs
-- | /O(n)/. Lookup the value at a key in the dictionary.
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 #-}
-- | /O(n + m)/. Merge two dictionaries by taking pair from both given
-- dictionaries. Dublicated keys are /not/ filtered.
--
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')
-- | /O(n)./ Map a function over all values in the dictionary.
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 #-}
-- | /O(n)/. Map each key\/value pair to a monoid and fold resulting
-- sequnce using 'mappend'.
--
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 #-}
-- | /O(n)/. Build a dictionary from a list of key\/value pairs where
-- the keys are in ascending order.
--
fromAscList :: [(BKey, a)] -> BDictMap a
fromAscList [] = Nil
fromAscList ((k, v) : xs) = Cons k v (fromAscList xs)
-- | /O(n)/. Convert the dictionary to a list of key\/value pairs
-- where the keys are in ascending order.
--
toAscList :: BDictMap a -> [(BKey, a)]
toAscList Nil = []
toAscList (Cons k v xs) = (k, v) : toAscList xs
|
