git.iko.soy/typeable/wai
on master help sign in
using NonEmpty.
commitf386412eea8c38cafe5f75db545e481fab62ce3a authorKazu Yamamoto <kazu@iij.ad.jp> dateWed 22 Nov 2017, 18:42 (9 years ago) parentdd79377
3 files changed+26−86
compare with master
unifiedsplit
warp/Network/Wai/Handler/Warp/MultiMap.hs+24−12 warp/Network/Wai/Handler/Warp/Some.hs−73 warp/warp.cabal+2−1
warp/Network/Wai/Handler/Warp/MultiMap.hs+24−12
@@ -1,5 +1,3 @@
1−{-# LANGUAGE CPP #-}
2−
31module Network.Wai.Handler.Warp.MultiMap (
42 MMap
53 , isEmpty
@@ -15,11 +13,14 @@ module Network.Wai.Handler.Warp.MultiMap (
1513
1614import Data.IntMap.Strict (IntMap)
1715import qualified Data.IntMap.Strict as I
18−import qualified Network.Wai.Handler.Warp.Some as S
16+import qualified Data.List.NonEmpty as NE
17+import Data.Semigroup
18+
19+import Network.Wai.Handler.Warp.Imports hiding ((<>), union, empty, insert)
1920
2021----------------------------------------------------------------
2122
22−type MMap v = IntMap (S.Some v)
23+type MMap v = IntMap (NonEmpty v)
2324
2425----------------------------------------------------------------
2526
@@ -35,7 +36,7 @@ empty = I.empty
3536
3637-- | O(1)
3738singleton :: Int -> v -> MMap v
38−singleton k v = I.singleton k (S.singleton v)
39+singleton k v = I.singleton k (v :| [])
3940
4041----------------------------------------------------------------
4142
@@ -43,19 +44,19 @@ singleton k v = I.singleton k (S.singleton v)
4344search :: Int -> MMap v -> Maybe v
4445search k m = case I.lookup k m of
4546 Nothing -> Nothing
46− Just s -> Just $! S.top s
47+ Just s -> Just $! NE.head s
4748
4849-- | O(log n)
4950searchWith :: Int -> (v -> Bool) -> MMap v -> Maybe v
5051searchWith k f m = case I.lookup k m of
51− Nothing -> Nothing
52− Just s -> S.lookupWith f s
52+ Nothing -> Nothing
53+ Just nxs -> find f $ NE.toList nxs
5354
5455----------------------------------------------------------------
5556
5657-- | O(log n)
5758insert :: Int -> v -> MMap v -> MMap v
58−insert k v m = I.insertWith S.union k (S.singleton v) m
59+insert k v m = I.insertWith (<>) k (v :| []) m
5960
6061----------------------------------------------------------------
6162
@@ -63,7 +64,7 @@ insert k v m = I.insertWith S.union k (S.singleton v) m
6364toList :: MMap v -> [v]
6465toList m = concatMap f $ I.toAscList m
6566 where
66− f (_,s) = S.toList s
67+ f (_,s) = NE.toList s
6768
6869----------------------------------------------------------------
6970
@@ -75,7 +76,7 @@ pruneWith m action = I.fromAscList <$> go (I.toDescList m) []
7576 where
7677 go [] acc = return acc
7778 go ((k,s):kss) acc = do
78− mt <- S.prune action s
79+ mt <- prune action s
7980 case mt of
8081 Nothing -> go kss acc
8182 Just t -> go kss ((k,t) : acc)
@@ -84,4 +85,15 @@ pruneWith m action = I.fromAscList <$> go (I.toDescList m) []
8485
8586-- O(n + m) where N is the size of the second argument
8687merge :: MMap v -> MMap v -> MMap v
87−merge m1 m2 = I.unionWith S.union m1 m2
88+merge m1 m2 = I.unionWith (<>) m1 m2
89+
90+----------------------------------------------------------------
91+
92+prune :: (a -> IO Bool) -> NonEmpty a -> IO (Maybe (NonEmpty a))
93+prune act nxs = NE.nonEmpty <$> go (NE.toList nxs)
94+ where
95+ go [] = return []
96+ go (x:xs) = do
97+ keep <- act x
98+ rs <- go xs
99+ return $ if keep then x:rs else rs
warp/Network/Wai/Handler/Warp/Some.hsdeleted−73
@@ -1,73 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−
3−module Network.Wai.Handler.Warp.Some (
4− Some
5− , singleton
6− , top
7− , lookupWith
8− , union
9− , toList
10− , prune
11− ) where
12−
13−----------------------------------------------------------------
14−
15−-- | One ore more list to implement multimap.
16−data Some a = One !a
17− | Tom !a !(Some a) -- Two or more
18− deriving (Eq,Show)
19−
20−{-# INLINE singleton #-}
21−singleton :: a -> Some a
22−singleton x = One x
23−
24−{-# INLINE top #-}
25−top :: Some a -> a
26−top (One x) = x
27−top (Tom x _) = x
28−
29−{-# INLINE lookupWith #-}
30−lookupWith :: (a -> Bool) -> Some a -> Maybe a
31−lookupWith f s = go s
32− where
33− go (One x)
34− | f x = Just x
35− | otherwise = Nothing
36− go (Tom x xs)
37− | f x = Just x
38− | otherwise = go xs
39−
40−{-# INLINE union #-}
41−union :: Some a -> Some a -> Some a
42−union s t = go s t
43− where
44− go (One x) u = Tom x u
45− go (Tom x xs) u = go xs (Tom x u)
46−
47−{-# INLINE toList #-}
48−toList :: Some a -> [a]
49−toList s = go s []
50− where
51− go (One x) !acc = x : acc
52− go (Tom x xs) !acc = go xs (x : acc)
53−
54−{-# INLINE prune #-}
55−prune :: (a -> IO Bool) -> Some a -> IO (Maybe (Some a))
56−prune act s = go s
57− where
58− go (One x) = do
59− keep <- act x
60− return $ if keep then
61− Just (One x)
62− else
63− Nothing
64− go (Tom x xs) = do
65− keep <- act x
66− mys <- go xs
67− return $ if keep then
68− case mys of
69− Nothing -> Just (One x)
70− Just ys -> Just (Tom x ys)
71− else
72− mys
73−
warp/warp.cabal+2−1
@@ -55,6 +55,7 @@ Library
5555 , word8
5656 , hashable
5757 , http-date
58+ , semigroups
5859 if flag(network-bytestring)
5960 Build-Depends: network >= 2.2.1.5 && < 2.2.3
6061 , network-bytestring >= 0.1.3 && < 0.1.4
@@ -92,7 +93,6 @@ Library
9293 Network.Wai.Handler.Warp.Run
9394 Network.Wai.Handler.Warp.SendFile
9495 Network.Wai.Handler.Warp.Settings
95− Network.Wai.Handler.Warp.Some
9696 Network.Wai.Handler.Warp.Timeout
9797 Network.Wai.Handler.Warp.Types
9898 Network.Wai.Handler.Warp.Windows
@@ -171,6 +171,7 @@ Test-Suite spec
171171 , word8
172172 , hashable
173173 , http-date
174+ , semigroups
174175
175176 if (os(linux) || os(freebsd) || os(darwin)) && flag(allow-sendfilefd)
176177 Cpp-Options: -DSENDFILEFD