@@ -1,18 +1,15 @@
1−{-# LANGUAGE CPP #-}
1+{-# LANGUAGE CPP, BangPatterns #-}
22
33module Network.Wai.Handler.Warp.MultiMap (
44 MMap
5− , Some(..)
5+ , isEmpty
66 , empty
77 , singleton
88 , insert
99 , search
1010 , searchWith
11− , isEmpty
1211 , pruneWith
1312 , toList
14− , fromSortedList
15− , toSortedList
1613 , merge
1714 ) where
1815
@@ -21,30 +18,27 @@ import Control.Applicative ((<$>))
2118#endif
2219import Data.IntMap (IntMap)
2320import qualified Data.IntMap as I
21+import qualified Network.Wai.Handler.Warp.Some as S
2422
2523----------------------------------------------------------------
2624
27−-- | One ore more list to implement multimap.
28−data Some a = One !a
29− | Tom !a !(Some a) -- Two or more
30− deriving (Eq,Show)
25+type MMap v = IntMap (S.Some v)
3126
32−{-
33−cons :: Some a -> a -> Some a
34−cons s x = Tom x s
35−-}
27+----------------------------------------------------------------
3628
37−top :: Some a -> a
38−top (One x) = x
39−top (Tom x _) = x
29+-- | O(1)
30+isEmpty :: MMap v -> Bool
31+isEmpty = I.null
4032
41−union :: Some a -> Some a -> Some a
42−union (One x) s = Tom x s
43−union (Tom x xs) s = union xs (Tom x s)
33+-- | O(1)
34+empty :: MMap v
35+empty = I.empty
4436
4537----------------------------------------------------------------
4638
47−type MMap v = IntMap (Some v)
39+-- | O(1)
40+singleton :: Int -> v -> MMap v
41+singleton k v = I.singleton k (S.singleton v)
4842
4943----------------------------------------------------------------
5044
@@ -52,35 +46,19 @@ type MMap v = IntMap (Some v)
5246search :: Int -> MMap v -> Maybe v
5347search k m = case I.lookup k m of
5448 Nothing -> Nothing
55− Just s -> Just $! top s
49+ Just s -> Just $! S.top s
5650
5751-- | O(log n)
58−searchWith :: Int -> (Some v -> Maybe v) -> MMap v -> Maybe v
52+searchWith :: Int -> (v -> Bool) -> MMap v -> Maybe v
5953searchWith k f m = case I.lookup k m of
6054 Nothing -> Nothing
61− Just s -> f s
62−
63−----------------------------------------------------------------
64−
65−-- | O(1)
66−isEmpty :: MMap v -> Bool
67−isEmpty = I.null
68−
69−-- | O(1)
70−empty :: MMap v
71−empty = I.empty
72−
73−----------------------------------------------------------------
74−
75−-- | O(1)
76−singleton :: Int -> v -> MMap v
77−singleton k v = I.singleton k (One v)
55+ Just s -> S.lookupWith f s
7856
7957----------------------------------------------------------------
8058
8159-- | O(log n)
8260insert :: Int -> v -> MMap v -> MMap v
83−insert k v m = I.insertWith union k (One v) m
61+insert k v m = I.insertWith S.union k (S.singleton v) m
8462
8563----------------------------------------------------------------
8664
@@ -88,33 +66,26 @@ insert k v m = I.insertWith union k (One v) m
8866toList :: MMap v -> [v]
8967toList m = concatMap f $ I.toAscList m
9068 where
91− f (_,s) = go s []
92− where
93− go (One x) acc = x : acc
94− go (Tom x xs) acc = go xs (x : acc)
95−
96−----------------------------------------------------------------
97−
98−-- | O(n)
99−fromSortedList :: [(Int,Some v)] -> MMap v
100−fromSortedList = I.fromAscList
101−
102−----------------------------------------------------------------
103−
104−-- | O(n)
105−toSortedList :: MMap v -> [(Int,Some v)]
106−toSortedList = I.toAscList
69+ f (_,s) = S.toList s
10770
10871----------------------------------------------------------------
10972
11073-- | O(n)
11174pruneWith :: MMap v
112− -> ((Int,Some v) -> IO [(Int, Some v)])
75+ -> (v -> IO Bool)
11376 -> IO (MMap v)
114−pruneWith m action = fromSortedList . concat <$> mapM action (toSortedList m)
77+pruneWith m action = I.fromAscList <$> go (I.toAscList m)
78+ where
79+ go [] = return []
80+ go ((k,s):kss) = do
81+ mt <- S.prune action s
82+ lst <- go kss
83+ case mt of
84+ Nothing -> return lst
85+ Just t -> return $ (k,t) : lst
11586
11687----------------------------------------------------------------
11788
11889-- O(n + m) where N is the size of the second argument
11990merge :: MMap v -> MMap v -> MMap v
120−merge m1 m2 = I.unionWith union m1 m2
91+merge m1 m2 = I.unionWith S.union m1 m2