module ExpiringContainers.ExpiringSet ( ExpiringSet, -- * Construction empty, singleton, -- * List toList, fromList, -- * Transformations map, -- * Basic interface null, insert, member, memberTime, size, -- * Filter clean, ) where import qualified Data.HashMap.Strict as A import qualified IntMultimap as B import qualified Data.HashSet as C import qualified Data.Foldable as D import qualified GHC.Exts as G import Data.Time import Data.Int import Prelude hiding(map, null) import GHC.Generics import Timestamp import Data.Hashable {-| Set that expiring with time -} data ExpiringSet element = ExpiringSet {-| Elements indexed by timestamps -} (B.IntMultiMap element) {-| Timestamps indexed by elements -} (A.HashMap element Int) deriving(Eq, Show, Generic) {-------------------------------------------------------------------- Transformations --------------------------------------------------------------------} map :: (Eq b, Hashable b) => (a -> b) -> ExpiringSet a -> ExpiringSet b map f (ExpiringSet intMultiMap _) = construct $ B.map f intMultiMap {-# 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) {-------------------------------------------------------------------- Lists --------------------------------------------------------------------} instance (Eq a, Hashable a) => G.IsList (ExpiringSet a) where type Item (ExpiringSet a) = (Int, a) toList = toList fromList = fromList toList :: ExpiringSet b -> [(Int, b)] toList (ExpiringSet intMultiMap _) = B.toList intMultiMap fromList :: (Eq a, Hashable a) => [(Int, a)] -> ExpiringSet a fromList = construct . B.fromList {-------------------------------------------------------------------- Construction --------------------------------------------------------------------} 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 {-# INLINABLE singleton #-} {-------------------------------------------------------------------- Filter --------------------------------------------------------------------} {-| Clean expiringset -} clean :: (Hashable element, Ord element) => UTCTime -> ExpiringSet element -> ([element], ExpiringSet element) clean time (ExpiringSet intMultiMap hashMap) = (listElem, ExpiringSet newMultiMap newHash) where key = fromIntegral $ (timestampMicroSecondsInt64 . utcTimeTimestamp) time newHash = A.filterWithKey (\_ k -> k >= key) hashMap (oldMultiMap, newMultiMap) = (B.split key intMultiMap) listElem = D.toList oldMultiMap {-------------------------------------------------------------------- Basic interface --------------------------------------------------------------------} null :: ExpiringSet a -> Bool null (ExpiringSet _ hashMap) = A.null hashMap {-# INLINE null #-} size :: ExpiringSet a -> Int size (ExpiringSet _ hashMap) = A.size hashMap 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 {-| -} insert :: (Hashable element, Ord element) => UTCTime {-^ Expiry time -} -> element -> ExpiringSet element -> ExpiringSet element insert time value (ExpiringSet intMultiMap hashMap) = 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