@@ -1,100 +1,111 @@
1+{-# LANGUAGE BangPatterns #-}
2+
13module Network.Wai.Handler.Warp.MultiMap (
2− MMap
4+ MultiMap
35 , isEmpty
46 , empty
57 , singleton
68 , insert
7− , search
8− , searchWith
9+ , Network.Wai.Handler.Warp.MultiMap.lookup
910 , pruneWith
1011 , toList
1112 , merge
1213 ) where
1314
15+import Data.Hashable (hash)
1416import Data.IntMap.Strict (IntMap)
1517import qualified Data.IntMap.Strict as I
16−import qualified Data.List.NonEmpty as NE
1718import Data.Semigroup
1819import Prelude -- Silence redundant import warnings
1920
20−import Network.Wai.Handler.Warp.Imports hiding ((<>), union, empty, insert)
21−
2221----------------------------------------------------------------
2322
24−type MMap v = IntMap (NonEmpty v)
23+-- | 'MultiMap' is used for cache of file descriptors.
24+-- Since multiple threads would open file descriptors for
25+-- the same file simultaneously, multiple entries must
26+-- be contained for the file.
27+-- Since hash values of file pathes are used as outer keys,
28+-- collison would happen for multiple file pathes.
29+-- Becase only positive entries are contained,
30+-- a bad guy cannot be cause the hash collision intentinally.
31+-- So, lists are good enough.
32+newtype MultiMap v = MultiMap (IntMap [(FilePath,v)])
2533
2634----------------------------------------------------------------
2735
2836-- | O(1)
29−isEmpty :: MMap v -> Bool
30−isEmpty = I.null
37+empty :: MultiMap v
38+empty = MultiMap $ I.empty
3139
3240-- | O(1)
33−empty :: MMap v
34−empty = I.empty
41+isEmpty :: MultiMap v -> Bool
42+isEmpty (MultiMap mm) = I.null mm
3543
3644----------------------------------------------------------------
3745
3846-- | O(1)
39−singleton :: Int -> v -> MMap v
40−singleton k v = I.singleton k (v :| [])
47+singleton :: FilePath -> v -> MultiMap v
48+singleton path v = MultiMap mm
49+ where
50+ !h = hash path
51+ !mm = I.singleton h [(path,v)]
4152
4253----------------------------------------------------------------
4354
44−-- | O(log n)
45−search :: Int -> MMap v -> Maybe v
46−search k m = case I.lookup k m of
55+-- | O(N)
56+lookup :: FilePath -> MultiMap v -> Maybe v
57+lookup path (MultiMap mm) = case I.lookup h mm of
4758 Nothing -> Nothing
48− Just s -> Just $! NE.head s
49−
50−-- | O(log n)
51−searchWith :: Int -> (v -> Bool) -> MMap v -> Maybe v
52−searchWith k f m = case I.lookup k m of
53− Nothing -> Nothing
54− Just nxs -> find f $ NE.toList nxs
59+ Just s -> Prelude.lookup path s
60+ where
61+ !h = hash path
5562
5663----------------------------------------------------------------
5764
5865-- | O(log n)
59−insert :: Int -> v -> MMap v -> MMap v
60−insert k v m = I.insertWith (<>) k (v :| []) m
66+insert :: FilePath -> v -> MultiMap v -> MultiMap v
67+insert path v (MultiMap mm) = MultiMap mm'
68+ where
69+ !h = hash path
70+ !mm' = I.insertWith (<>) h [(path,v)] mm
6171
6272----------------------------------------------------------------
6373
6474-- | O(n)
65−toList :: MMap v -> [v]
66−toList m = concatMap f $ I.toAscList m
67− where
68− f (_,s) = NE.toList s
75+toList :: MultiMap v -> [(FilePath,v)]
76+toList (MultiMap mm) = concatMap snd $ I.toAscList mm
6977
7078----------------------------------------------------------------
7179
7280-- | O(n)
73−pruneWith :: MMap v
74− -> (v -> IO Bool)
75− -> IO (MMap v)
76−pruneWith m action = I.fromAscList <$> go (I.toDescList m) []
81+pruneWith :: MultiMap v
82+ -> ((FilePath,v) -> IO Bool)
83+ -> IO (MultiMap v)
84+pruneWith (MultiMap mm) action = MultiMap <$> mm'
7785 where
78− go [] acc = return acc
79− go ((k,s):kss) acc = do
80− mt <- prune action s
81− case mt of
82− Nothing -> go kss acc
83− Just t -> go kss ((k,t) : acc)
86+ !mm' = I.fromAscList <$> go (I.toDescList mm) []
87+ go [] !acc = return acc
88+ go ((h,s):kss) !acc = do
89+ rs <- prune action s
90+ case rs of
91+ [] -> go kss acc
92+ _ -> go kss ((h,rs) : acc)
8493
8594----------------------------------------------------------------
8695
8796-- O(n + m) where N is the size of the second argument
88−merge :: MMap v -> MMap v -> MMap v
89−merge m1 m2 = I.unionWith (<>) m1 m2
97+merge :: MultiMap v -> MultiMap v -> MultiMap v
98+merge (MultiMap m1) (MultiMap m2) = MultiMap mm
99+ where
100+ !mm = I.unionWith (<>) m1 m2
90101
91102----------------------------------------------------------------
92103
93−prune :: (a -> IO Bool) -> NonEmpty a -> IO (Maybe (NonEmpty a))
94−prune act nxs = NE.nonEmpty <$> go (NE.toList nxs)
104+prune :: ((FilePath,v) -> IO Bool) -> [(FilePath,v)] -> IO [(FilePath,v)]
105+prune action xs0 = go xs0
95106 where
96107 go [] = return []
97108 go (x:xs) = do
98− keep <- act x
109+ keep <- action x
99110 rs <- go xs
100111 return $ if keep then x:rs else rs