summaryrefslogtreecommitdiff
path: root/src/Data/BEncode/BDict.hs
blob: 2f5d7c373bf20b278e69842d8e9abda96260fdc2 (plain)
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
153
154
155
156
-- |
--   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.Semigroup
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 Semigroup (BDictMap a) where
  (<>) = Data.BEncode.BDict.union

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