expiring-containers 0.1.1.1 → 0.1.2

raw patch · 4 files changed

+198/−23 lines, 4 filesdep +expiring-containersdep +quickcheck-instancesdep +tastydep ~int-multimapPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: expiring-containers, quickcheck-instances, tasty, tasty-hunit, tasty-quickcheck

Dependency ranges changed: int-multimap

API changes (from Hackage documentation)

Files

• expiring-containers.cabal +27/−2
• library/ExpiringContainers/ExpiringMap.hs +84/−5
• library/ExpiringContainers/ExpiringSet.hs +26/−16
• test/Main.hs +61/−0

@@ -1,7 +1,7 @@ name:   expiring-containers version:-  0.1.1.1+  0.1.2 synopsis:   Expiring containers category:@@ -49,5 +49,30 @@     hashable >=1.2 && <2,     timestamp >=0.2 && <0.3,     containers >=0.5.10 && <0.5.15,-    int-multimap >=0.2 && <0.3,+    int-multimap >=0.2.1 && <0.3,     unordered-containers >=0.2.8.0 && <0.3++test-suite test+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    test+  main-is:+    Main.hs+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  build-depends:+    expiring-containers,+    base >=4.7 && <5,+    time >=1.8 && <2,+    hashable >=1.2 && <2,+    timestamp >=0.2 && <0.3,+    containers >=0.5.10 && <0.5.15,+    int-multimap >=0.2.1 && <0.3,+    unordered-containers >=0.2.8.0 && <0.3,+    tasty >=1.0.1 && <1.0.2,+    tasty-hunit >=0.9 && <0.11,+    tasty-quickcheck >=0.10 && <0.12,+    quickcheck-instances >=0.3.18 && <0.4

@@ -1,9 +1,27 @@ module ExpiringContainers.ExpiringMap (   ExpiringMap,-  insert,   lookup,   setCurrentTime,++  -- * Construction+  empty,+  singleton,++  -- * List+  toList,+  fromList,++  -- * Transformations+  map,+  mapWithKey,++  -- * Basic interface+  null,+  size,+  member,+  insert,+  delete, ) where @@ -11,9 +29,11 @@ import qualified Data.HashMap.Strict as B import Data.Time import Data.Maybe-import Prelude hiding (lookup)+import Prelude hiding (lookup, null, map) import Data.Hashable+import qualified Data.Foldable as D import qualified Data.List as C+import qualified GHC.Exts as G  {-| @@ -22,16 +42,75 @@   ExpiringMap     (A.ExpiringSet key)     (B.HashMap key value)+    deriving (Foldable) -insert :: (Eq key, Ord key, Hashable key) => UTCTime {-^ Expiry time -} -> key -> value -> ExpiringMap key value -> ExpiringMap key value+{--------------------------------------------------------------------+  Transformations+--------------------------------------------------------------------}+map :: (v1 -> v2) -> ExpiringMap k v1 -> ExpiringMap k v2+map f = mapWithKey (const f)+{-# INLINE map #-}++mapWithKey :: (k -> v1 -> v2) -> ExpiringMap k v1 -> ExpiringMap k v2+mapWithKey f (ExpiringMap expiringSet hashMap) =+  ExpiringMap expiringSet $ B.mapWithKey f hashMap++{--------------------------------------------------------------------+  Lists+--------------------------------------------------------------------}+instance (Eq a, Hashable a) => G.IsList (ExpiringMap a b) where+  type Item (ExpiringMap a b) = (UTCTime, a, b)+  toList = toList+  fromList = fromList++toList :: (Eq k, Hashable k) => ExpiringMap k v -> [(UTCTime, k, v)]+toList (ExpiringMap expiringSet hashMap) =+  fmap (\(time, key) -> (time, key, hashMap B.! key)) $ A.toList expiringSet++fromList :: (Eq k, Hashable k) =>+     [(UTCTime, k, v)] -> ExpiringMap k v+fromList list = ExpiringMap expSet hashMap+  where+    (expSetList, hashMapList) = D.foldl' (\(xs, ys) (t,k,v) -> ((t,k) : xs, (k,v) : ys)) ([], []) list+    expSet = A.fromList expSetList+    hashMap = B.fromList hashMapList++{--------------------------------------------------------------------+  Construction+--------------------------------------------------------------------}+empty :: (Eq k, Hashable k) => ExpiringMap k v+empty = ExpiringMap A.empty B.empty++singleton :: (Eq k, Hashable k) => UTCTime -> k -> v -> ExpiringMap k v+singleton time k v = ExpiringMap (A.singleton time k) (B.singleton k v)+{-# INLINABLE singleton #-}++{--------------------------------------------------------------------+  Basic interface+--------------------------------------------------------------------}+null :: ExpiringMap k v -> Bool+null (ExpiringMap _ hashMap) = B.null hashMap+{-# INLINE null #-}++size :: ExpiringMap k v -> Int+size (ExpiringMap _ hashMap) = B.size hashMap++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 time key value (ExpiringMap expSet hashMap) =   ExpiringMap (A.insert time key expSet) (B.insert key value hashMap) -lookup :: (Eq key, Hashable key) => key -> ExpiringMap key value -> Maybe value+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)++lookup :: (Eq k, Hashable k) => k -> ExpiringMap k v -> Maybe v lookup key (ExpiringMap expSet hashMap) =   B.lookup key hashMap -setCurrentTime :: (Eq key, Ord key, Hashable key) => UTCTime -> ExpiringMap key value -> ExpiringMap key value+setCurrentTime :: (Eq k, Ord 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,+  delete,   member,   memberTime,   size,@@ -64,16 +65,16 @@   Lists --------------------------------------------------------------------} instance (Eq a, Hashable a) => G.IsList (ExpiringSet a) where-  type Item (ExpiringSet a) = (Int, a)+  type Item (ExpiringSet a) = (UTCTime, a)   toList = toList   fromList = fromList -toList :: ExpiringSet b -> [(Int, b)]-toList (ExpiringSet intMultiMap _) = B.toList intMultiMap+toList :: ExpiringSet a -> [(UTCTime, a)]+toList (ExpiringSet intMultiMap _) = fmap (\(k, a) -> (,) (timestampUtcTime $ Timestamp $ fromIntegral k) a) $ B.toList intMultiMap  fromList :: (Eq a, Hashable a) =>-     [(Int, a)] -> ExpiringSet a-fromList = construct . B.fromList+     [(UTCTime, a)] -> ExpiringSet a+fromList = construct . B.fromList . fmap (\(t, a) -> (,) (fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) t) a)  {--------------------------------------------------------------------   Construction@@ -81,8 +82,10 @@ empty :: (Eq a, Hashable a) => ExpiringSet a empty = ExpiringSet B.empty A.empty -singleton :: (Eq a, Hashable a) => Int -> a -> ExpiringSet a-singleton k v = construct $ B.singleton k v+singleton :: (Eq a, Hashable a) => UTCTime -> a -> ExpiringSet a+singleton time v = construct $ B.singleton key v+  where+    key = fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) time {-# INLINABLE singleton #-}  @@ -98,8 +101,11 @@   where     key = fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) time     newHash = A.filterWithKey (\_ k -> k >= key) hashMap-    (oldMultiMap, newMultiMap) = (B.split key intMultiMap)-    listElem = D.toList oldMultiMap+    (oldMultiMap, maybeElem, newMultiMap) = (B.splitLookup key intMultiMap)+    element = case maybeElem of+      Just a -> D.toList a+      Nothing -> []+    listElem = (D.toList oldMultiMap) ++ element  {--------------------------------------------------------------------   Basic interface@@ -114,9 +120,10 @@ member :: (Eq a, Hashable a) => a -> ExpiringSet a -> Bool member a (ExpiringSet _ hashMap) = A.member a hashMap -memberTime :: Int -> ExpiringSet a -> Bool-memberTime key (ExpiringSet intMultiMap _) = B.member key intMultiMap-+memberTime :: UTCTime -> ExpiringSet a -> Bool+memberTime time (ExpiringSet intMultiMap _) = B.member key intMultiMap+  where+    key = fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) time {-|  -}@@ -125,7 +132,10 @@   ExpiringSet newMultiMap (A.insert value key hashMap)   where     key = fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) time-    startKey = A.lookup value hashMap-    newMultiMap = B.insert key value $ case startKey of-      Just k -> B.delete k value intMultiMap-      Nothing -> intMultiMap+    newMultiMap = B.insert key value intMultiMap++delete :: (Hashable element, Ord element) => UTCTime {-^ Expiry time -} -> element -> ExpiringSet element -> ExpiringSet element+delete time element (ExpiringSet intMultiMap _) =+  construct $ B.delete key element intMultiMap+  where+    key = fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) time

@@ -0,0 +1,61 @@+module Main where++import Prelude hiding (first, second)+import Control.Arrow+import Test.Tasty+import Test.Tasty.Runners+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+-- import Test.QuickCheck.Instances+import Test.QuickCheck.Instances.Time+import qualified ExpiringContainers.ExpiringSet as A+import qualified ExpiringContainers.ExpiringMap as B+import qualified Data.List as C+import Data.Maybe+import Data.Time+import Data.Foldable as F+import qualified Data.Set as D+import Timestamp++main =+  defaultMain $+  testGroup "All tests" $+  [+    expiringSet+    ,+    expiringMap+  ]++expiringSet =+  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)+    ,+    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)+    ,+    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 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 "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)+  ]++expiringMap =+  testGroup "Expiring Map" $+  [+  ]++testFunc :: (Show a) => a -> String+testFunc = show++testFuncL :: (Show a)  => (UTCTime, a) -> (UTCTime, String)+testFuncL (a, b) = (a, show b)