f386412 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

using NonEmpty.

f386412Kazu Yamamoto9 years ago

warp/Network/Wai/Handler/Warp/MultiMap.hs+24−12

compare with master

unifiedsplit

@@ -1,5 +1,3 @@

1−{-# LANGUAGE CPP #-}

2−

3module Network.Wai.Handler.Warp.MultiMap (

1module Network.Wai.Handler.Warp.MultiMap (

4 MMap

2 MMap

5 , isEmpty

3 , isEmpty

@@ -15,11 +13,14 @@ module Network.Wai.Handler.Warp.MultiMap (

16import Data.IntMap.Strict (IntMap)

14import Data.IntMap.Strict (IntMap)

17import qualified Data.IntMap.Strict as I

15import qualified Data.IntMap.Strict as I

16+import qualified Data.List.NonEmpty as NE

17+import Data.Semigroup

18+

18−import qualified Network.Wai.Handler.Warp.Some as S

19+import Network.Wai.Handler.Warp.Imports hiding ((<>), union, empty, insert)

20----------------------------------------------------------------

21----------------------------------------------------------------

22−type MMap v = IntMap (S.Some v)

23+type MMap v = IntMap (NonEmpty v)

24----------------------------------------------------------------

25----------------------------------------------------------------

@@ -35,7 +36,7 @@ empty = I.empty

36-- | O(1)

37-- | O(1)

37singleton :: Int -> v -> MMap v

38singleton :: Int -> v -> MMap v

38−singleton k v = I.singleton k (S.singleton v)

39+singleton k v = I.singleton k (v :| [])

40----------------------------------------------------------------

41----------------------------------------------------------------

@@ -43,19 +44,19 @@ singleton k v = I.singleton k (S.singleton v)

43search :: Int -> MMap v -> Maybe v

44search :: Int -> MMap v -> Maybe v

44search k m = case I.lookup k m of

45search k m = case I.lookup k m of

45 Nothing -> Nothing

46 Nothing -> Nothing

46− Just s -> Just $! S.top s

47+ Just s -> Just $! NE.head s

48-- | O(log n)

49-- | O(log n)

49searchWith :: Int -> (v -> Bool) -> MMap v -> Maybe v

50searchWith :: Int -> (v -> Bool) -> MMap v -> Maybe v

50searchWith k f m = case I.lookup k m of

51searchWith k f m = case I.lookup k m of

51− Nothing -> Nothing

52+ Nothing -> Nothing

52− Just s -> S.lookupWith f s

53+ Just nxs -> find f $ NE.toList nxs

54----------------------------------------------------------------

55----------------------------------------------------------------

56-- | O(log n)

57-- | O(log n)

57insert :: Int -> v -> MMap v -> MMap v

58insert :: 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

60----------------------------------------------------------------

61----------------------------------------------------------------

@@ -63,7 +64,7 @@ insert k v m = I.insertWith S.union k (S.singleton v) m

63toList :: MMap v -> [v]

64toList :: MMap v -> [v]

64toList m = concatMap f $ I.toAscList m

65toList m = concatMap f $ I.toAscList m

65 where

66 where

66− f (_,s) = S.toList s

67+ f (_,s) = NE.toList s

68----------------------------------------------------------------

69----------------------------------------------------------------

@@ -75,7 +76,7 @@ pruneWith m action = I.fromAscList <$> go (I.toDescList m) []

75 where

76 where

76 go [] acc = return acc

77 go [] acc = return acc

77 go ((k,s):kss) acc = do

78 go ((k,s):kss) acc = do

78− mt <- S.prune action s

79+ mt <- prune action s

79 case mt of

80 case mt of

80 Nothing -> go kss acc

81 Nothing -> go kss acc

81 Just t -> go kss ((k,t) : acc)

82 Just t -> go kss ((k,t) : acc)

@@ -84,4 +85,15 @@ pruneWith m action = I.fromAscList <$> go (I.toDescList m) []

85-- O(n + m) where N is the size of the second argument

86-- O(n + m) where N is the size of the second argument

86merge :: MMap v -> MMap v -> MMap v

87merge :: 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

55 , word8

56 , hashable

57 , http-date

58+ , semigroups

58 if flag(network-bytestring)

59 if flag(network-bytestring)

59 Build-Depends: network >= 2.2.1.5 && < 2.2.3

60 Build-Depends: network >= 2.2.1.5 && < 2.2.3

60 , network-bytestring >= 0.1.3 && < 0.1.4

61 , network-bytestring >= 0.1.3 && < 0.1.4

@@ -92,7 +93,6 @@ Library

92 Network.Wai.Handler.Warp.Run

93 Network.Wai.Handler.Warp.Run

93 Network.Wai.Handler.Warp.SendFile

94 Network.Wai.Handler.Warp.SendFile

94 Network.Wai.Handler.Warp.Settings

95 Network.Wai.Handler.Warp.Settings

95− Network.Wai.Handler.Warp.Some

96 Network.Wai.Handler.Warp.Timeout

97 Network.Wai.Handler.Warp.Types

98 Network.Wai.Handler.Warp.Windows

@@ -171,6 +171,7 @@ Test-Suite spec

171 , word8

172 , hashable

173 , http-date

174+ , semigroups

174

175

175 if (os(linux) || os(freebsd) || os(darwin)) && flag(allow-sendfilefd)

176 if (os(linux) || os(freebsd) || os(darwin)) && flag(allow-sendfilefd)

176 Cpp-Options: -DSENDFILEFD

177 Cpp-Options: -DSENDFILEFD