expiring-containers 0.1.2 → 0.2

raw patch · 4 files changed

+198/−34 lines, 4 filesdep ~int-multimapPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: int-multimap

API changes (from Hackage documentation)

Files

• expiring-containers.cabal +3/−3
• library/ExpiringContainers/ExpiringMap.hs +6/−6
• library/ExpiringContainers/ExpiringSet.hs +54/−14
• test/Main.hs +135/−11

@@ -1,7 +1,7 @@ name:   expiring-containers version:-  0.1.2+  0.2 synopsis:   Expiring containers category:@@ -49,7 +49,7 @@     hashable >=1.2 && <2,     timestamp >=0.2 && <0.3,     containers >=0.5.10 && <0.5.15,-    int-multimap >=0.2.1 && <0.3,+    int-multimap >=0.3.1 && <0.4,     unordered-containers >=0.2.8.0 && <0.3  test-suite test@@ -70,7 +70,7 @@     hashable >=1.2 && <2,     timestamp >=0.2 && <0.3,     containers >=0.5.10 && <0.5.15,-    int-multimap >=0.2.1 && <0.3,+    int-multimap >=0.3.1 && <0.4,     unordered-containers >=0.2.8.0 && <0.3,     tasty >=1.0.1 && <1.0.2,     tasty-hunit >=0.9 && <0.11,

@@ -42,7 +42,7 @@   ExpiringMap     (A.ExpiringSet key)     (B.HashMap key value)-    deriving (Foldable)+    deriving (Eq, Foldable, Show)  {--------------------------------------------------------------------   Transformations@@ -98,19 +98,19 @@ member :: (Eq k, Hashable k) => k -> ExpiringMap k v -> Bool member key (ExpiringMap _ hashMap) = B.member key hashMap -insert :: (Eq k, Ord k, Hashable k) => UTCTime {-^ Expiry time -} -> k -> v -> ExpiringMap k v -> ExpiringMap k v+insert :: (Eq k,  Hashable k) => UTCTime {-^ Expiry time -} -> k -> v -> ExpiringMap k v -> ExpiringMap k v insert time key value (ExpiringMap expSet hashMap) =   ExpiringMap (A.insert time key expSet) (B.insert key value hashMap) -delete :: (Eq k, Ord k, Hashable k) => UTCTime {-^ Expiry time -} -> k  -> ExpiringMap k v -> ExpiringMap k v-delete time key (ExpiringMap expSet hashMap) =-  ExpiringMap (A.delete time key expSet) (B.delete key hashMap)+delete :: (Eq k, Hashable k) => k -> ExpiringMap k v -> ExpiringMap k v+delete key (ExpiringMap expSet hashMap) =+  ExpiringMap (A.delete key expSet) (B.delete key hashMap)  lookup :: (Eq k, Hashable k) => k -> ExpiringMap k v -> Maybe v lookup key (ExpiringMap expSet hashMap) =   B.lookup key hashMap -setCurrentTime :: (Eq k, Ord k, Hashable k) => UTCTime -> ExpiringMap k v -> ExpiringMap k v+setCurrentTime :: (Eq k, Hashable k) => UTCTime -> ExpiringMap k v -> ExpiringMap k v setCurrentTime time (ExpiringMap expSet hashMap) =   ExpiringMap newExpSet newHashMap     where

@@ -15,6 +15,7 @@   -- * Basic interface   null,   insert,+  insertForce,   delete,   member,   memberTime,@@ -36,6 +37,7 @@ import GHC.Generics import Timestamp import Data.Hashable+import Control.Arrow  {-| Set that expiring with time@@ -43,7 +45,7 @@ data ExpiringSet element =   ExpiringSet     {-| Elements indexed by timestamps -}-    (B.IntMultiMap element)+    (B.IntMultimap element)     {-| Timestamps indexed by elements -}     (A.HashMap element Int)     deriving(Eq, Show, Generic)@@ -54,13 +56,26 @@   Transformations --------------------------------------------------------------------} map :: (Eq b, Hashable b) => (a -> b) -> ExpiringSet a -> ExpiringSet b-map f (ExpiringSet intMultiMap _) = construct $ B.map f intMultiMap+map f (ExpiringSet intMultimap hashMap) = uncurry ExpiringSet $ B.foldlWithKey' step (B.empty, A.empty) intMultimap where+  step stamp (!intMultimap', !hashMap') x+    | Just v <- A.lookup y hashMap' = (B.insert stamp y $ B.delete v y intMultimap', A.insert y stamp hashMap')+    | otherwise = (B.insert stamp y intMultimap', A.insert y stamp hashMap')+    where y = f x {-# INLINE map #-} -construct :: (Eq a, Hashable a) => B.IntMultiMap a -> ExpiringSet a-construct intMultiMap = ExpiringSet intMultiMap $-  A.fromList $ fmap (\(k, v) -> (v, k)) (B.toList intMultiMap)+construct :: (Eq k, Hashable k) => A.HashMap k Int -> ExpiringSet k+construct hashMap = ExpiringSet intMultimap hashMap+  where+    intMultimap = hashToMap hashMap +hashToMap :: (Eq a, Hashable a) => A.HashMap a Int -> B.IntMultimap a+hashToMap hashMap =+  A.foldlWithKey' (\intMultiMap key value -> B.insert value key intMultiMap) B.empty hashMap++mapKeys :: (Eq k2, Hashable k2) => (k1 -> k2) -> A.HashMap k1 a -> A.HashMap k2 a+mapKeys f hashMap = A.fromList $ fmap (first f) $ (A.toList hashMap)++ {--------------------------------------------------------------------   Lists --------------------------------------------------------------------}@@ -74,7 +89,7 @@  fromList :: (Eq a, Hashable a) =>      [(UTCTime, a)] -> ExpiringSet a-fromList = construct . B.fromList . fmap (\(t, a) -> (,) (fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) t) a)+fromList = construct . A.fromList . fmap (\(t, a) -> (,) a (fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) t))  {--------------------------------------------------------------------   Construction@@ -83,7 +98,7 @@ empty = ExpiringSet B.empty A.empty  singleton :: (Eq a, Hashable a) => UTCTime -> a -> ExpiringSet a-singleton time v = construct $ B.singleton key v+singleton time v = construct $ A.singleton v key   where     key = fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) time {-# INLINABLE singleton #-}@@ -95,7 +110,7 @@ {-| Clean expiringset -}-clean :: (Hashable element, Ord element) => UTCTime -> ExpiringSet element -> ([element], ExpiringSet element)+clean :: (Hashable element, Eq element) => UTCTime -> ExpiringSet element -> ([element], ExpiringSet element) clean time (ExpiringSet intMultiMap hashMap) =   (listElem, ExpiringSet newMultiMap newHash)   where@@ -124,18 +139,43 @@ memberTime time (ExpiringSet intMultiMap _) = B.member key intMultiMap   where     key = fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) time++insertForce :: (Hashable element, Eq element) => UTCTime {-^ Expiry time -} -> element -> ExpiringSet element -> ExpiringSet element+insertForce time value (ExpiringSet intMultiMap hashMap) =+  ExpiringSet newMultiMap (A.insert value key hashMap)+  where+    key = fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) time+    maybeTimestamp = A.lookup value hashMap+    newMultiMap = case maybeTimestamp of+      Nothing -> B.insert key value intMultiMap+      Just k -> B.insert key value $ B.delete k value intMultiMap+ {-|  -}-insert :: (Hashable element, Ord element) => UTCTime {-^ Expiry time -} -> element -> ExpiringSet element -> ExpiringSet element+insert :: (Hashable element, Eq element) => UTCTime {-^ Expiry time -} -> element -> ExpiringSet element -> ExpiringSet element insert time value (ExpiringSet intMultiMap hashMap) =-  ExpiringSet newMultiMap (A.insert value key hashMap)+  ExpiringSet newMultiMap newHash   where     key = fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) time-    newMultiMap = B.insert key value intMultiMap+    maybeTimestamp = A.lookup value hashMap+    (newMultiMap, newHash) = case maybeTimestamp of+      Nothing -> (B.insert key value intMultiMap, A.insert value key hashMap)+      Just k -> if key >= k+        then (B.insert key value $ B.delete k value intMultiMap, A.insert value key hashMap)+        else (intMultiMap, hashMap) -delete :: (Hashable element, Ord element) => UTCTime {-^ Expiry time -} -> element -> ExpiringSet element -> ExpiringSet element-delete time element (ExpiringSet intMultiMap _) =-  construct $ B.delete key element intMultiMap+deleteByTime :: (Hashable element, Eq element) => UTCTime {-^ Expiry time -} -> element -> ExpiringSet element -> ExpiringSet element+deleteByTime time element (ExpiringSet _ hashMap) =+  construct $ A.delete element hashMap   where     key = fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) time++delete :: (Hashable element, Eq element) => element -> ExpiringSet element -> ExpiringSet element+delete value (ExpiringSet intMultiMap hashMap) =+  ExpiringSet newMultiMap (A.delete value hashMap)+  where+    maybeKey = A.lookup value hashMap+    newMultiMap = case maybeKey of+      Nothing -> intMultiMap+      Just key -> B.delete key value intMultiMap

@@ -15,6 +15,7 @@ import Data.Time import Data.Foldable as F import qualified Data.Set as D+import qualified Data.HashMap.Strict as E import Timestamp  main =@@ -30,28 +31,151 @@   testGroup "Expiring Set" $   [     testProperty "list to list" $ \ (list :: [(UTCTime, Int)]) ->-    (D.fromList $ fmap (\(t,a) -> (,) (timestampUtcTime $ utcTimeTimestamp t) a) list) === (D.fromList $ A.toList $ A.fromList list)+    (D.fromList $ C.nubBy (\(t1,v1) (t2,v2) -> v1 == v2) $ C.reverse $ map (\(t,a) -> (,) (timestampUtcTime $ utcTimeTimestamp t) a) list) ===+       (D.fromList $ A.toList $ A.fromList list)     ,     testProperty "delete" $ \ (list :: [(UTCTime, Int)], key :: UTCTime, value :: Int) ->-    (D.fromList $ fmap (\(t,a) -> (,) (timestampUtcTime $ utcTimeTimestamp t) a) $ C.delete (key, value) list) === (D.fromList $ A.toList $ A.delete key value $ A.fromList list)+    let list2 = C.nubBy (\(t1,k1) (t2,k2) -> k1 == k2) list+    in (D.fromList $ fmap (\(t,a) -> (,) (timestampUtcTime $ utcTimeTimestamp t) a) $+     C.deleteBy (\(_,v1) (_,v2) -> v1 == v2) (key, value) list2) ===+        (D.fromList $ A.toList $ A.delete value $ A.fromList list2)     ,-    testProperty "insert" $ \ (list :: [(UTCTime, Int)], key :: UTCTime, value :: Int) ->-    (D.fromList $ fmap (\(t,a) -> (,) (timestampUtcTime $ utcTimeTimestamp t) a) $ C.insert (key, value) list) === (D.fromList $ A.toList $ A.insert key value $ A.fromList list)+    testProperty "insert and insert" $ \ (list :: [(UTCTime, Int)], key1 :: UTCTime, value1 :: Int, key2 :: UTCTime,  value2 :: Int) ->+    let set = A.fromList list+    in if key1 == key2 || value1 == value2+        then (A.insert key1 value1 $ A.insert key1 value2 set) === (A.insert key1 value1 set)+        else (A.insert key1 value1 $ A.insert key2 value2 set) === (A.insert key2 value2 $ A.insert key1 value1 set)     ,-    testProperty "insert and delete" $ \ (list :: [(UTCTime, Int)], key :: UTCTime, value :: Int) ->-    (D.fromList $ fmap (\(t,a) -> (,) (timestampUtcTime $ utcTimeTimestamp t) a) list) === (D.fromList $ A.toList $ A.delete key value $ A.insert key value $ A.fromList list)+    testProperty "delete ans insert" $ \ (list :: [(UTCTime, Int)], key :: UTCTime, value1 :: Int, value2 :: Int) ->+    let set = A.fromList list+    in if value1 == value2+        then (A.delete value1 $ A.insert key value1 set) === (A.delete value1 set)+        else (A.delete value1 $ A.insert key value2 set) === (A.insert key value2 $ A.delete value1 set)     ,-    testProperty "clean" $ \ (list :: [(UTCTime, Int)], key :: UTCTime) ->-    let (list1, expire) = A.clean key $ A.fromList list-    in (D.fromList $ fmap (\(t,a) -> a) $ C.filter (\(t,a) -> t < key) list) === (D.fromList list1)+    testProperty "member and insert" $ \ (list :: [(UTCTime, Int)], key :: UTCTime, value1 :: Int, value2 :: Int) ->+    let set = A.fromList list+    in if value1 == value2+        then (A.member value1 $ A.insert key value1 set) === True+        else (A.member value1 $ A.insert key value2 set) === (A.member value1 set)     ,-    testProperty "mapping" $ \ (list :: [(UTCTime, Int)]) ->-    (D.fromList $ map (testFuncL . (\(t,a) -> (,) (timestampUtcTime $ utcTimeTimestamp t) a)) list) === (D.fromList $ A.toList $ A.map testFunc $ A.fromList list)+    testProperty "member and delete" $ \ (list :: [(UTCTime, Int)], value1 :: Int, value2 :: Int) ->+    let set = A.fromList list+    in if value1 == value2+        then (A.member value1 $ A.delete value1 set) === False+        else (A.member value1 $ A.delete value2 set) === (A.member value1 set)+    ,+    testProperty "map" $ \ (list :: [(UTCTime, Int)], value1 :: Int, value2 :: Int) ->+    let set = A.fromList list+    in A.map id set === id set+    ,+    testProperty "map insert" $ \ (list :: [(UTCTime, Int)], key :: UTCTime, value1 :: Int, fun :: (Fun Int Char)) ->+    let set = A.fromList list+        f = applyFun fun+    in A.map f (A.insert key value1 set) === A.insert key (f value1) (A.map f set)+    ,+    -- testProperty "map delete" $ \ (list :: [(UTCTime, Int)], key :: UTCTime, value1 :: Int, fun :: (Fun Int Char)) ->+    -- let set = A.fromList list+    --     f = applyFun fun+    -- in A.map f (A.delete value1 set) === A.delete (f value1) (A.map f set)+    -- ,+    -- testProperty "clean" $ \ (list :: [(UTCTime, Int)], key :: UTCTime) ->+    -- let (list1, expire) = A.clean key $ A.fromList list+    -- in (D.fromList $ fmap (\(t,a) -> a) $ C.filter (\(t,a) -> t < key) list) === (D.fromList list1)+    -- ,+    -- testProperty "mapping" $ \ (list :: [(UTCTime, Int)]) ->+    -- (D.fromList $ map (testFuncL . (\(t,a) -> (,) (timestampUtcTime $ utcTimeTimestamp t) a)) list) ===+    --    (D.fromList $ A.toList $ A.map testFunc $ A.fromList list)+    -- ,+    testProperty "member" $ \ (list :: [(UTCTime, Int)], key :: UTCTime, value :: Int) ->+    (A.member value $ A.delete value $ A.insert key value $ A.fromList list) === False   ]  expiringMap =   testGroup "Expiring Map" $   [+    testProperty "list to list" $ \ (list :: [(UTCTime, Int, Int)]) ->+    let list2 = C.nubBy (\(t1,k1,v1) (t2,k2,v2) -> k1 == k2) list+    in (D.fromList $ fmap (\(t,a,b) -> (,,) (timestampUtcTime $ utcTimeTimestamp t) a b) list2) ===+       (D.fromList $ B.toList $ B.fromList list2)+    ,+    testProperty "delete" $ \ (list :: [(UTCTime, Int, Int)], time :: UTCTime, key :: Int, value :: Int) ->+    let list2 = C.nubBy (\(t1,k1,v1) (t2,k2,v2) -> k1 == k2) list+    in (D.fromList $+      fmap (\(t,a,b) -> (,,) (timestampUtcTime $ utcTimeTimestamp t) a b) $+      C.deleteBy (\(t1,k1,v1) (t2,k2,v2) -> k1 == k2) (time, key, value) list2) ===+         (D.fromList $ B.toList $ B.delete key $ B.fromList list2)+    ,+    testProperty "insert and insert" $ \ (list :: [(UTCTime, Int, Int)], time1 :: UTCTime, key1 :: Int, value1 :: Int, time2 :: UTCTime, key2 :: Int, value2 :: Int) ->+    let map' = B.fromList list+    in if time1 == time2 || key1 == key2+        then (B.insert time1 key1 value1 $ B.insert time1 key1 value2 map') === (B.insert time1 key1 value1 map')+        else (B.insert time1 key1 value1 $ B.insert time2 key2 value2 map') === (B.insert time2 key2 value2 $ B.insert time1 key1 value1 map')+    ,+    testProperty "delete and insert" $ \ (list :: [(UTCTime, Int, Int)], time :: UTCTime, key1 :: Int, key2 :: Int, value :: Int) ->+    let map' = B.fromList list+    in if key1 == key2+        then (B.delete key1 $ B.insert time key1 value map') === (B.delete key1 map')+        else (B.delete key1 $ B.insert time key2 value map') === (B.insert time key2 value $ B.delete key1 map')+    ,+    testProperty "member and insert" $ \ (list :: [(UTCTime, Int, Int)], time :: UTCTime, key1 :: Int, key2 :: Int, value :: Int) ->+    let map' = B.fromList list+    in if key1 == key2+        then (B.member key1 $ B.insert time key1 value map') === True+        else (B.member key1 $ B.insert time key2 value map') === (B.member key1 map')+    ,+    testProperty "member and delete" $ \ (list :: [(UTCTime, Int, Int)], key1 :: Int, key2 :: Int) ->+    let map' = B.fromList list+    in if key1 == key2+        then (B.member key1 $ B.delete key1 map') === False+        else (B.member key1 $ B.delete key2 map') === (B.member key1 map')+    ,+    testProperty "member and insert" $ \ (list :: [(UTCTime, Int, Int)], time :: UTCTime, key1 :: Int, key2 :: Int, value :: Int) ->+    let map' = B.fromList list+    in if key1 == key2+        then (B.lookup key1 $ B.insert time key1 value map') === Just value+        else (B.lookup key1 $ B.insert time key2 value map') === (B.lookup key1 map')+    ,+    testProperty "lookup and delete" $ \ (list :: [(UTCTime, Int, Int)], key1 :: Int, key2 :: Int) ->+    let map' = B.fromList list+    in if key1 == key2+        then (B.lookup key1 $ B.delete key1 map') === Nothing+        else (B.lookup key1 $ B.delete key2 map') === (B.lookup key1 map')+    ,+    testProperty "map" $ \ (list :: [(UTCTime, Int, Int)], value1 :: Int, value2 :: Int) ->+    let map' = B.fromList list+    in B.map id map' === id map'+    ,+    testProperty "map insert" $ \ (list :: [(UTCTime, Int, Int)], time :: UTCTime, key :: Int, value1 :: Int, fun :: (Fun Int Char)) ->+    let map' = B.fromList list+        f = applyFun fun+    in B.map f (B.insert time key value1 map') === B.insert time key (f value1) (B.map f map')+    ,+    testProperty "map delete" $ \ (list :: [(UTCTime, Int, Int)], time :: UTCTime, key :: Int, value1 :: Int, fun :: (Fun Int Char)) ->+    let map' = B.fromList list+        f = applyFun fun+    in B.map f (B.delete key map') === B.delete key (B.map f map')+    ,+    testProperty "map lookup" $ \ (list :: [(UTCTime, Int, Int)], time :: UTCTime, key :: Int, value1 :: Int, fun :: (Fun Int Char)) ->+    let map' = B.fromList list+        f = applyFun fun+    in fmap f (B.lookup key map') === B.lookup key (B.map f map')+    ,+    -- testProperty "map" $ \ (list :: [(UTCTime, Int, Int)], time :: UTCTime, key :: Int, value :: Int) ->+    -- let map' = B.fromList list+    -- in fmap (\x -> B.insert time key value map') (B.lookup key map') === (map' <$ (B.lookup key map'))+    -- ,+    -- testProperty "clean" $ \ (list :: [(UTCTime, Int)], key :: UTCTime) ->+    -- let (list1, expire) = A.clean key $ A.fromList list+    -- in (D.fromList $ fmap (\(t,a) -> a) $ C.filter (\(t,a) -> t < key) list) === (D.fromList list1)+    -- ,+    testProperty "member" $ \ (list :: [(UTCTime, Int, Int)], time :: UTCTime, key :: Int, value :: Int) ->+    (B.member key $ B.delete key $ B.insert time key value $ B.fromList list) === False+    -- ,+    -- testProperty "insert and delete" $ \ (list :: [(UTCTime, Int, Int)], time :: UTCTime, key :: Int, value :: Int) ->+    -- let list2 = C.nubBy (\(t1,k1,v1) (t2,k2,v2) -> k1 == k2) list+    -- in (D.fromList $ fmap (\(t,a,b) -> (,,) (timestampUtcTime $ utcTimeTimestamp t) a b) $+    --  C.deleteBy (\(t1,k1,v1) (t2,k2,v2) -> k1 == k2) (time, key, value) list2) === (D.fromList $ B.toList $ B.delete key $ B.insert time key value $ B.fromList list)+   ]  testFunc :: (Show a) => a -> String