expiring-cache-map (empty) → 0.0.5.0

raw patch · 17 files changed

+1208/−0 lines, 17 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, hashable, time, unordered-containers

Files

Caching/ExpiringCacheMap/HashECM.hs +209/−0
Caching/ExpiringCacheMap/Internal/Internal.hs +111/−0
Caching/ExpiringCacheMap/Internal/Types.hs +45/−0
Caching/ExpiringCacheMap/OrdECM.hs +205/−0
Caching/ExpiringCacheMap/Types.hs +38/−0
Caching/ExpiringCacheMap/Utils/TestSequence.hs +163/−0
Caching/ExpiringCacheMap/Utils/Types.hs +37/−0
LICENSE +30/−0
README.md +7/−0
Setup.hs +2/−0
expiring-cache-map.cabal +68/−0
tests/TestHashECMWithTestSequence.hs +49/−0
tests/TestHashECMWithThreads.hs +85/−0
tests/TestOrdECMWithTestSequence.hs +49/−0
tests/TestOrdECMWithThreads.hs +84/−0
tests/TestWithTestSequence.hs +9/−0
tests/TestWithThreads.hs +17/−0

+ Caching/ExpiringCacheMap/HashECM.hs view

@@ -0,0 +1,209 @@+{-# LANGUAGE OverloadedStrings #-}
+-- |
+-- Module : Caching.ExpiringCacheMap.HashECM
+-- Copyright: (c) 2014 Edward L. Blake
+-- License: BSD-style
+-- Maintainer: Edward L. Blake <edwardlblake@gmail.com>
+-- Stability: experimental
+-- Portability: portable
+--
+-- A cache that holds values for a length of time that uses 'Hashable' keys
+-- with "Data.HashMap.Strict".
+--
+-- An example of creating a cache for accessing files:
+--
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- > module Example where
+-- > 
+-- > import Caching.ExpiringCacheMap.HashECM (newECMIO, lookupECM, CacheSettings(..), consistentDuration)
+-- > 
+-- > import qualified Data.Time.Clock.POSIX as POSIX (POSIXTime, getPOSIXTime)
+-- > import qualified Data.ByteString.Char8 as BS
+-- > import System.IO (withFile, IOMode(ReadMode))
+-- > 
+-- > example = do
+-- >   filecache <- newECMIO
+-- >         (consistentDuration 100 -- Duration between access and expiry time of each item
+-- >           (\state id -> do BS.putStrLn "Reading a file again..."
+-- >                            withFile (case id :: BS.ByteString of
+-- >                                        "file1" -> "file1.txt"
+-- >                                        "file2" -> "file2.txt")
+-- >                               ReadMode $
+-- >                               \fh -> do content <- BS.hGetContents fh
+-- >                                         return $! (state, content)))
+-- >         (do time <- POSIX.getPOSIXTime
+-- >             return (round (time * 100)))
+-- >         12000 -- Time check frequency: (accumulator `mod` this_number) == 0.
+-- >         (CacheWithLRUList
+-- >           6     -- Expected size of key-value map when removing elements.
+-- >           6     -- Size of list when to remove items from key-value map.
+-- >           12    -- Size of list when to compact
+-- >           )
+-- >   
+-- >   -- Use lookupECM whenever the contents of "file1" is needed.
+-- >   b <- lookupECM filecache "file1"
+-- >   BS.putStrLn b
+-- >   return ()
+-- > 
+-- 
+
+module Caching.ExpiringCacheMap.HashECM (
+    
+    -- * Create cache
+    newECMIO,
+    newECMForM,
+    consistentDuration,
+    
+    -- * Request value from cache
+    lookupECM,
+    
+    -- * Type
+    ECM,
+    CacheSettings(..)
+) where
+
+import qualified Control.Concurrent.MVar as MV
+import qualified Data.HashMap.Strict as HM
+import qualified Data.List as L
+import Data.Hashable (Hashable(..))
+
+import Caching.ExpiringCacheMap.Internal.Internal (updateUses, detECM)
+import Caching.ExpiringCacheMap.Types
+import Caching.ExpiringCacheMap.Internal.Types
+
+-- | Create a new expiring cache for retrieving uncached values via 'IO'
+-- interaction (such as in the case of reading a file from disk), with 
+-- a shared state lock via an 'MV.MVar' to manage cache state.
+-- 
+newECMIO :: (Eq k, Hashable k) => (Maybe s -> k -> IO (TimeUnits, (Maybe s, v))) -> (IO TimeUnits)
+  -> ECMIncr 
+  -> CacheSettings
+    -> IO (ECM IO MV.MVar s HM.HashMap k v)
+newECMIO retr gettime timecheckmodulo cachesettings = do
+  newECMForM retr gettime timecheckmodulo cachesettings
+    MV.newMVar MV.modifyMVar MV.readMVar
+  
+-- | Create a new expiring cache along arbitrary monads with provided
+-- functions to create cache state in 'Monad' m2, and modify and read
+-- cache state in 'Monad' m1.
+--
+newECMForM :: (Monad m1, Monad m2) => (Eq k, Hashable k) => (Maybe s -> k -> m1 (TimeUnits, (Maybe s, v))) -> (m1 TimeUnits)
+  -> ECMIncr 
+  -> CacheSettings
+  -> ECMNewState m2 mv s HM.HashMap k v
+  -> ECMEnterState m1 mv s HM.HashMap k v
+  -> ECMReadState m1 mv s HM.HashMap k v
+    -> m2 (ECM m1 mv s HM.HashMap k v)
+newECMForM retr gettime timecheckmodulo (CacheWithLRUList minimumkeep removalsize compactlistsize)
+           newstate enterstate readstate = do
+  m'maps <- newstate $ CacheState ( Nothing, HM.empty, ([], 0), 0 )
+  return $ ECM ( m'maps, retr, gettime, minimumkeep, 
+                 timecheckmodulo, removalsize, compactlistsize,
+                 enterstate, readstate )
+
+
+-- | Request a value associated with a key from the cache.
+--
+--  * If the value is not in the cache, the value will be requested through the 
+--    function defined when the 'ECM' value was created, its computation
+--    returned and the value stored in the cache state map.
+-- 
+--  * If the value is in the cache and has not expired, it will be returned.
+-- 
+--  * If the value is in the cache and a new time is computed in the same
+--    lookup, and the value has been determined to have since expired, it 
+--    will be discarded and a new value will be requested for this computation.
+--
+-- Every 'lookupECM' computation increments an accumulator in the cache state
+-- which is used to keep track of the succession of key accesses. This history 
+-- of key accesses is then used to remove entries from the cache back down to 
+-- a minimum size. Also, when the modulo of the accumulator and the modulo 
+-- value computes to 0, the time request function defined when the 'ECM' value
+-- was created is invoked for the current time to determine of which if any of
+-- the entries in the cache state map needs to be removed. In some cases the 
+-- accumulator may get incremented more than once in a 'lookupECM' computation.
+--
+-- As the accumulator is a bound unsigned integer, when the accumulator
+-- increments back to 0, the cache state is completely cleared.
+-- 
+lookupECM :: (Monad m, Eq k, Hashable k) => ECM m mv s HM.HashMap k v -> k -> m v
+lookupECM ecm id = do
+  enter m'maps $
+    \(CacheState (retr_state, maps, uses, incr)) ->
+      let incr' = incr + 1
+       in if incr' < incr
+            -- Word incrementor has cycled back to 0,
+            -- so may as well clear the cache completely.
+            then lookupECM' (retr_state, HM.empty, ([], 0), 0) (0+1)
+            else lookupECM' (retr_state, maps, uses, incr) incr'
+  where
+  
+    ECM ( m'maps, retr, gettime, minimumkeep, timecheckmodulo, removalsize, 
+          compactlistsize, enter, _ro ) = ecm
+    
+    mnub = HM.toList . HM.fromList . reverse
+    lookupECM' (retr_state, maps, uses, incr) incr' = do
+      let uses' = updateUses uses id incr' compactlistsize mnub
+      (ret, do_again) <- det retr_state maps uses' incr'
+      if do_again
+        then do let (CacheState (retr_state', maps', uses'', incr''), _) = ret
+                    uses''' = updateUses uses'' id incr'' compactlistsize mnub
+                (ret', _) <- det retr_state' maps' uses''' incr''
+                return ret'
+        else return ret
+    
+    det retr_state maps uses' incr' =
+      detECM (HM.lookup id maps) retr_state (retr retr_state id)
+        (\time_r -> HM.insert id time_r maps)
+        (\time_r keepuses -> HM.insert id time_r $! HM.intersection maps $ HM.fromList keepuses)
+        mnub
+        gettime
+        HM.filter
+        uses' incr' timecheckmodulo maps minimumkeep removalsize
+
+
+{-
+-- This function differs from 'lookupECM' only in the case that the value
+-- being requested also causes a new time to have been computed during the 
+-- same lookup, and have been found to be out of date. When the condition 
+-- happens, this function returns the old cached value without attempting
+-- to request a new value, despite being out of date. However, it does
+-- clear the key from the key-value store for the next request.
+-- 
+lookupECMUse :: (Monad m, Eq k, Hashable k) => ECM m mv s HM.HashMap k v -> k -> m v
+lookupECMUse ecm id = do
+  enter m'maps $
+    \(CacheState (retr_state, maps, uses, incr)) ->
+      let incr' = incr + 1
+       in if incr' < incr
+            -- Word incrementor has cycled back to 0,
+            -- so may as well clear the cache completely.
+            then lookupECM' (retr_state, HM.empty, ([], 0), 0) (0+1)
+            else lookupECM' (retr_state, maps, uses, incr) incr'
+  where
+  
+    ECM ( m'maps, retr, gettime, minimumkeep, timecheckmodulo, removalsize, 
+          compactlistsize, enter, _ro ) = ecm
+    
+    mnub = HM.toList . HM.fromList . reverse
+    lookupECM' (retr_state, maps, uses, incr) incr' = do
+      let uses' = updateUses uses id incr' compactlistsize mnub
+      (ret, _) <-
+          detECM (HM.lookup id maps) retr_state (retr retr_state id)
+            (\time_r -> HM.insert id time_r maps)
+            (\time_r keepuses -> HM.insert id time_r $! HM.intersection maps $ HM.fromList keepuses)
+            mnub
+            gettime
+            HM.filter
+            uses' incr' timecheckmodulo maps minimumkeep removalsize
+      return ret
+-}
+
+
+-- | Used with 'newECMIO' or 'newECMForM' to provide a consistent duration for requested values.
+consistentDuration :: (Monad m, Eq k, Hashable k) => TimeUnits -> (Maybe s -> k -> m (Maybe s, v)) -> (Maybe s -> k -> m (TimeUnits, (Maybe s, v)))
+consistentDuration duration fun =
+  \state id -> do
+    ret <- fun state id
+    return (duration, ret)
+

+ Caching/ExpiringCacheMap/Internal/Internal.hs view

@@ -0,0 +1,111 @@+{-# LANGUAGE OverloadedStrings #-}
+-- |
+-- Module : Caching.ExpiringCacheMap.Internal
+-- Copyright: (c) 2014 Edward L. Blake
+-- License: BSD-style
+-- Maintainer: Edward L. Blake <edwardlblake@gmail.com>
+-- Stability: experimental
+-- Portability: portable
+--
+-- A module with internal functions used in common by HashECM and OrdECM.
+-- Assume these functions to change from version to version.
+-- 
+
+module Caching.ExpiringCacheMap.Internal.Internal (
+    updateUses,
+    detECM,
+    getStatsString
+) where
+
+import qualified Data.List as L
+
+import Caching.ExpiringCacheMap.Types
+import Caching.ExpiringCacheMap.Internal.Types
+
+updateUses :: (Eq k) => ([(k, ECMIncr)], ECMULength) -> k
+  -> ECMIncr -> ECMULength -> ([(k, ECMIncr)] -> [(k, ECMIncr)])
+    -> ([(k, ECMIncr)], ECMULength)
+{-# INLINE updateUses #-}
+updateUses uses id incr' compactlistsize compactUses =
+    case uses of
+        (((id', _) : rest), lcount) | id' == id ->
+          (((id', incr') : rest), lcount)
+        ((latest : (id', _) : rest), lcount) | id' == id ->
+          (((id', incr') : latest : rest), lcount)
+        ((latest : latest' : (id', _) : rest), lcount) | id' == id ->
+          (((id', incr') : latest : latest' : rest), lcount)
+        (usesl, lcount) ->
+          if lcount > compactlistsize
+            then let newusesl = compactUses usesl
+                  in ((id, incr') : newusesl, (L.length newusesl) + 1)
+            else ((id, incr') : usesl, lcount+1)
+
+detECM
+  :: (Monad m, Eq k) =>
+     Maybe (TimeUnits, TimeUnits, v)
+     -> Maybe s
+     -> m (TimeUnits, (Maybe s, v))
+     -> ((TimeUnits, TimeUnits, v) -> mp k (TimeUnits, TimeUnits, v))
+     -> ((TimeUnits, TimeUnits, v) -> [(k, ECMIncr)] -> mp k (TimeUnits, TimeUnits, v))
+     -> ([(k, ECMIncr)] -> [(k, ECMIncr)])
+     -> m TimeUnits
+     -> (((TimeUnits, TimeUnits, v) -> Bool)
+         -> mp k (TimeUnits, TimeUnits, v) -> mp k (TimeUnits, TimeUnits, v))
+     -> ([(k, ECMIncr)], ECMULength)
+     -> ECMIncr
+     -> ECMIncr
+     -> mp k (TimeUnits, TimeUnits, v)
+     -> ECMMapSize
+     -> ECMULength
+       -> m ((CacheState s mp k v, v), Bool)
+{-# INLINE detECM #-}
+detECM result retr_state retr_id insert_id1 insert_id2 mnub gettime filt uses' incr' timecheckmodulo maps minimumkeep removalsize = 
+    case result of
+        Nothing -> do
+          (expirytime, (retr_state', r)) <- retr_id
+          time <- gettime
+          let (newmaps,newuses) = insertAndPerhapsRemoveSome time r expirytime uses'
+          return $! ((CacheState (retr_state', newmaps, newuses, incr'), r), False)
+        Just (_accesstime, _expirytime, m) -> do
+          if incr' `mod` timecheckmodulo == 0
+            then do
+              time <- gettime
+              return ((CacheState (retr_state, filterExpired time maps, uses', incr'), m), True)
+            else return ((CacheState (retr_state, maps, uses', incr'), m), False)
+  where
+  
+    getKeepAndRemove =
+      finalTup . splitAt minimumkeep . reverse . 
+          sortI . map swap2 . mnub
+        where swap2 (a,b) = (b,a)
+              finalTup (l1,l2) = 
+                (map (\(c,k) -> (k,c)) l1, map (\(c,k) -> k) l2)
+              sortI = L.sortBy (\(l,_) (r,_) -> compare l r)
+    
+    insertAndPerhapsRemoveSome time r expirytime uses =
+      if lcount >= removalsize
+        then 
+          let (keepuses, _removekeys) = getKeepAndRemove usesl
+              newmaps = insert_id2 (time, expirytime, r) keepuses
+           in (filterExpired time newmaps, (keepuses, L.length keepuses))
+        else
+          let newmaps = insert_id1 (time, expirytime, r)
+           in (filterExpired time newmaps, uses)
+      where
+        (usesl, lcount) = uses
+    
+    filterExpired time =
+      filt (\(accesstime, expirytime, value) ->
+                 (accesstime <= time) &&
+                   (accesstime > (time - expirytime)))
+
+
+-- | Debugging function
+--
+getStatsString ecm = do
+  CacheState (_retr_state, _maps, uses, _incr) <- ro m'uses
+  return $ show uses
+  where
+    ECM ( m'uses, _retr, _gettime, _minimumkeep, _timecheckmodulo, _removalsize,
+          _compactlistsize, _enter, ro ) = ecm
+

+ Caching/ExpiringCacheMap/Internal/Types.hs view

@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings #-}
+-- |
+-- Module : Caching.ExpiringCacheMap.Internal.Types
+-- Copyright: (c) 2014 Edward L. Blake
+-- License: BSD-style
+-- Maintainer: Edward L. Blake <edwardlblake@gmail.com>
+-- Stability: experimental
+-- Portability: portable
+--
+-- Internal types.
+-- 
+
+module Caching.ExpiringCacheMap.Internal.Types (
+    -- * Cache internals
+    ECM(..),
+    CacheState(..),
+    ECMNewState,
+    ECMEnterState,
+    ECMReadState
+) where
+
+import qualified Control.Concurrent.MVar as MV
+import Caching.ExpiringCacheMap.Utils.Types
+
+type ECMNewState a b s m k v = (CacheState s m k v) -> a (b (CacheState s m k v))
+
+type ECMEnterState a b s m k v = b (CacheState s m k v) -> ((CacheState s m k v) -> a ((CacheState s m k v), v)) -> a v
+
+type ECMReadState a b s m k v = b (CacheState s m k v) -> a (CacheState s m k v)
+
+-- | The cache state.
+newtype CacheState s m k v =
+  CacheState (Maybe s, m k (TimeUnits, TimeUnits, v), ([(k, ECMIncr)], ECMULength), ECMIncr)
+
+-- | The type that encapsulates a cache map.
+newtype ECM a b s m k v = ECM ( b (CacheState s m k v),
+                  Maybe s -> k -> a (TimeUnits, (Maybe s, v)),
+                  a TimeUnits,
+                  ECMMapSize,
+                  -- TimeUnits,
+                  ECMIncr,
+                  ECMULength,
+                  ECMULength,
+                  ECMEnterState a b s m k v,
+                  ECMReadState a b s m k v)

+ Caching/ExpiringCacheMap/OrdECM.hs view

@@ -0,0 +1,205 @@+{-# LANGUAGE OverloadedStrings #-}
+-- |
+-- Module : Caching.ExpiringCacheMap.OrdECM
+-- Copyright: (c) 2014 Edward L. Blake
+-- License: BSD-style
+-- Maintainer: Edward L. Blake <edwardlblake@gmail.com>
+-- Stability: experimental
+-- Portability: portable
+--
+-- A cache that holds values for a length of time that uses 'Ord' keys with 
+-- "Data.Map.Strict".
+-- 
+-- An example of creating a cache for accessing files:
+--
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- > module Example where
+-- > 
+-- > import Caching.ExpiringCacheMap.OrdECM (newECMIO, lookupECM, CacheSettings(..), consistentDuration)
+-- > 
+-- > import qualified Data.Time.Clock.POSIX as POSIX (POSIXTime, getPOSIXTime)
+-- > import qualified Data.ByteString.Char8 as BS
+-- > import System.IO (withFile, IOMode(ReadMode))
+-- > 
+-- > example = do
+-- >   filecache <- newECMIO
+-- >         (consistentDuration 100 -- Duration between access and expiry time of each item
+-- >           (\state id -> do BS.putStrLn "Reading a file again..."
+-- >                            withFile (case id :: BS.ByteString of
+-- >                                        "file1" -> "file1.txt"
+-- >                                        "file2" -> "file2.txt")
+-- >                               ReadMode $
+-- >                               \fh -> do content <- BS.hGetContents fh
+-- >                                         return $! (state, content)))
+-- >         (do time <- POSIX.getPOSIXTime
+-- >             return (round (time * 100)))
+-- >         12000 -- Time check frequency: (accumulator `mod` this_number) == 0.
+-- >         (CacheWithLRUList
+-- >           6     -- Expected size of key-value map when removing elements.
+-- >           6     -- Size of list when to remove items from key-value map.
+-- >           12    -- Size of list when to compact
+-- >           )
+-- >   
+-- >   -- Use lookupECM whenever the contents of "file1" is needed.
+-- >   b <- lookupECM filecache "file1"
+-- >   BS.putStrLn b
+-- >   return ()
+-- > 
+--
+
+module Caching.ExpiringCacheMap.OrdECM (
+    -- * Create cache
+    newECMIO,
+    newECMForM,
+    consistentDuration,
+    
+    -- * Request value from cache
+    lookupECM,
+    
+    -- * Type
+    ECM,
+    CacheSettings(..)
+) where
+
+import qualified Control.Concurrent.MVar as MV
+import qualified Data.Map.Strict as M
+import qualified Data.List as L
+
+import Caching.ExpiringCacheMap.Internal.Internal (updateUses, detECM)
+import Caching.ExpiringCacheMap.Types
+import Caching.ExpiringCacheMap.Internal.Types
+
+-- | Create a new expiring cache for retrieving uncached values via 'IO'
+-- interaction (such as in the case of reading a file from disk), with
+-- a shared state lock via an 'MV.MVar' to manage cache state.
+--
+newECMIO :: Ord k => (Maybe s -> k -> IO (TimeUnits, (Maybe s, v))) -> (IO TimeUnits)
+  -> ECMIncr 
+  -> CacheSettings
+    -> IO (ECM IO MV.MVar s M.Map k v)
+newECMIO retr gettime timecheckmodulo settings = do
+  newECMForM retr gettime timecheckmodulo settings
+    MV.newMVar MV.modifyMVar MV.readMVar
+
+-- | Create a new expiring cache along arbitrary monads with provided
+-- functions to create cache state in 'Monad' m2, and modify and read
+-- cache state in 'Monad' m1.
+--
+newECMForM :: (Monad m1, Monad m2) => Ord k => (Maybe s -> k -> m1 (TimeUnits, (Maybe s, v))) -> (m1 TimeUnits)
+  -> ECMIncr
+  -> CacheSettings
+  -> ECMNewState m2 mv s M.Map k v
+  -> ECMEnterState m1 mv s M.Map k v
+  -> ECMReadState m1 mv s M.Map k v
+    -> m2 (ECM m1 mv s M.Map k v)
+newECMForM retr gettime timecheckmodulo (CacheWithLRUList minimumkeep removalsize compactlistsize)
+           newstate enterstate readstate = do
+  m'maps <- newstate $ CacheState ( Nothing, M.empty, ([], 0), 0 )
+  return $ ECM ( m'maps, retr, gettime, minimumkeep, timecheckmodulo, removalsize,
+                 compactlistsize, enterstate, readstate )
+
+-- | Request a value associated with a key from the cache.
+--
+--  * If the value is not in the cache, it will be requested through the 
+--    function defined through 'newECM', its computation returned and the
+--    value stored in the cache state map.
+-- 
+--  * If the value is in the cache and has not expired, it will be returned.
+--
+--  * If the value is in the cache and a new time is computed in the same
+--    lookup, and the value has been determined to have since expired, it 
+--    will be discarded and a new value will be requested for this computation.
+--
+-- Every 'lookupECM' computation increments an accumulator in the cache state 
+-- which is used to keep track of the succession of key accesses. This history 
+-- of key accesses is then used to remove entries from the cache back down to 
+-- a minimum size. Also, when the modulo of the accumulator and the modulo 
+-- value computes to 0, the time request function defined when the 'ECM' value
+-- was created is invoked for the current time to determine of which if any of
+-- the entries in the cache state map needs to be removed. In some cases the 
+-- accumulator may get incremented more than once in a 'lookupECM' computation.
+--
+-- As the accumulator is a bound unsigned integer, when the accumulator
+-- increments back to 0, the cache state is completely cleared.
+-- 
+lookupECM :: (Monad m, Ord k) => ECM m mv s M.Map k v -> k -> m v
+lookupECM ecm id = do
+  enter m'maps $
+    \(CacheState (retr_state, maps, uses, incr)) ->
+      let incr' = incr + 1
+       in if incr' < incr
+            -- Word incrementor has cycled back to 0,
+            -- so may as well clear the cache completely.
+            then lookupECM' (retr_state, M.empty, ([], 0), 0) (0+1)
+            else lookupECM' (retr_state, maps, uses, incr) incr'
+  where
+    
+    ECM ( m'maps, retr, gettime, minimumkeep, timecheckmodulo, removalsize,
+          compactlistsize, enter, _ro ) = ecm
+  
+    mnub = M.toList . M.fromList . reverse
+    lookupECM' (retr_state, maps, uses, incr) incr' = do
+      let uses' = updateUses uses id incr' compactlistsize mnub
+      (ret, do_again) <- det retr_state maps uses' incr'
+      if do_again
+        then do let (CacheState (retr_state', maps', uses'', incr''), _) = ret
+                    uses''' = updateUses uses'' id incr'' compactlistsize mnub
+                (ret', _) <- det retr_state' maps' uses''' incr''
+                return ret'
+        else return ret
+    
+    det retr_state maps uses' incr' =
+      detECM (M.lookup id maps) retr_state (retr retr_state id)
+        (\time_r -> M.insert id time_r maps)
+        (\time_r keepuses -> M.insert id time_r $! M.intersection maps $ M.fromList keepuses)
+        mnub
+        gettime
+        M.filter
+        uses' incr' timecheckmodulo maps minimumkeep removalsize
+    
+
+{-
+-- This function differs from 'lookupECM' only in the case that the value
+-- being requested also causes a new time to have been computed during the 
+-- same lookup, and have been found to be out of date. When the condition 
+-- happens, this function returns the old cached value without attempting
+-- to request a new value, despite being out of date. However, it does
+-- clear the key from the key-value store for the next request.
+--
+lookupECMUse :: (Monad m, Ord k) => ECM m mv s M.Map k v -> k -> m v
+lookupECMUse ecm id = do
+  enter m'maps $
+    \(CacheState (retr_state, maps, uses, incr)) ->
+      let incr' = incr + 1
+       in if incr' < incr
+            -- Word incrementor has cycled back to 0,
+            -- so may as well clear the cache completely.
+            then lookupECM' (retr_state, M.empty, ([], 0), 0) (0+1)
+            else lookupECM' (retr_state, maps, uses, incr) incr'
+  where
+    
+    ECM ( m'maps, retr, gettime, minimumkeep, timecheckmodulo, removalsize,
+          compactlistsize, enter, _ro ) = ecm
+  
+    mnub = M.toList . M.fromList . reverse
+    lookupECM' (retr_state, maps, uses, incr) incr' = do
+      let uses' = updateUses uses id incr' compactlistsize mnub
+      (ret, _) <-
+          detECM (M.lookup id maps) retr_state (retr retr_state id)
+            (\time_r -> M.insert id time_r maps)
+            (\time_r keepuses -> M.insert id time_r $! M.intersection maps $ M.fromList keepuses)
+            mnub
+            gettime
+            M.filter
+            uses' incr' timecheckmodulo maps minimumkeep removalsize
+      return ret
+-}
+
+
+-- | Used with 'newECMIO' or 'newECMForM' to provide a consistent duration for requested values.
+consistentDuration :: (Monad m, Ord k) => TimeUnits -> (Maybe s -> k -> m (Maybe s, v)) -> (Maybe s -> k -> m (TimeUnits, (Maybe s, v)))
+consistentDuration duration fun =
+  \state id -> do
+    ret <- fun state id
+    return (duration, ret)
+

+ Caching/ExpiringCacheMap/Types.hs view

@@ -0,0 +1,38 @@+{-# LANGUAGE OverloadedStrings #-}
+-- |
+-- Module : Caching.ExpiringCacheMap.Types
+-- Copyright: (c) 2014 Edward L. Blake
+-- License: BSD-style
+-- Maintainer: Edward L. Blake <edwardlblake@gmail.com>
+-- Stability: experimental
+-- Portability: portable
+--
+-- Types common to "Caching.ExpiringCacheMap.OrdECM" and "Caching.ExpiringCacheMap.HashECM".
+-- 
+
+module Caching.ExpiringCacheMap.Types (
+    -- * Configuration
+    CacheSettings(..),
+    -- * Cache encapsulation
+    ECM,
+    CacheState,
+    -- * Types
+    TimeUnits,
+    ECMMapSize,
+    ECMULength,
+    ECMIncr,
+    -- * Types for state function
+    ECMNewState,
+    ECMEnterState,
+    ECMReadState,
+) where
+
+import Caching.ExpiringCacheMap.Utils.Types
+import Caching.ExpiringCacheMap.Internal.Types
+
+data CacheSettings =
+  CacheWithLRUList {
+    mapsize :: ECMMapSize,
+    removalsize :: ECMULength,
+    compactlistsize :: ECMULength
+  }

+ Caching/ExpiringCacheMap/Utils/TestSequence.hs view

@@ -0,0 +1,163 @@+-- |
+-- Module : Caching.ExpiringCacheMap.Utils.TestSequence
+-- Copyright: (c) 2014 Edward L. Blake
+-- License: BSD-style
+-- Maintainer: Edward L. Blake <edwardlblake@gmail.com>
+-- Stability: experimental
+-- Portability: portable
+--
+-- TestSequence monad for testing caching behaviour.
+--
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- > 
+-- > module TestSequenceExample where
+-- > 
+-- > import Caching.ExpiringCacheMap.HashECM (newECMForM, lookupECM, CacheSettings(..), consistentDuration)
+-- > import qualified Caching.ExpiringCacheMap.Utils.TestSequence as TestSeq
+-- > 
+-- > import qualified Data.ByteString.Char8 as BS
+-- > 
+-- > test = do
+-- >   (TestSeq.TestSequenceState (_, events, _), return_value) <- TestSeq.runTestSequence test'
+-- >   (putStrLn . show . reverse) events
+-- >   return ()
+-- >   where
+-- >     test' = do
+-- >       filecache <- newECMForM
+-- >             (consistentDuration 100 -- Duration between access and expiry time of each item, no state needed.
+-- >               (\state _id -> do number <- TestSeq.readNumber
+-- >                                 return (state, number)))
+-- >             (TestSeq.getCurrentTime >>= return)
+-- >             12000 -- Time check frequency: (accumulator `mod` this_number) == 0.
+-- >             (CacheWithLRUList 
+-- >               6   -- Expected size of key-value map when removing elements.
+-- >               6   -- Size of list when to remove items from key-value map.
+-- >               12  -- Size of list when to compact
+-- >               )
+-- >             TestSeq.newTestSVar TestSeq.enterTestSVar TestSeq.readTestSVar
+-- >       
+-- >       -- Use lookupECM whenever the contents of "file1" is needed.
+-- >       b <- lookupECM filecache ("file1" :: BS.ByteString)
+-- >       TestSeq.haveNumber b
+-- >       b <- lookupECM filecache "file1"
+-- >       b <- lookupECM filecache "file2"
+-- >       TestSeq.haveNumber b
+-- >       return b
+-- >
+--
+-- >>> test
+-- [GetVar 3,ReadNumber 4,GetTime 7,PutVar 11,HaveNumber 4,GetVar 14,PutVar 17,
+--  GetVar 19,ReadNumber 20,GetTime 23,PutVar 27,HaveNumber 20]
+-- 
+--
+
+module Caching.ExpiringCacheMap.Utils.TestSequence (
+    runTestSequence,
+    newTestSVar,
+    enterTestSVar,
+    readTestSVar,
+    getCurrentTime,
+    readNumber,
+    haveNumber,
+    TestSequenceEvents(..),
+    TestSequenceState(..),
+    TestSequence(..),
+    TestSVar(..)
+) where
+
+import Data.Word (Word32)
+
+data TestSequenceEvents = 
+  GetVar Word32 |
+  PutVar Word32 |
+  GetTime Word32 |
+  ReadNumber Int |
+  HaveNumber Int
+  deriving (Eq)
+
+instance Show TestSequenceEvents where
+  show (GetVar a)     = "GetVar " ++ (show a)
+  show (PutVar a)     = "PutVar " ++ (show a)
+  show (GetTime a)    = "GetTime " ++ (show a)
+  show (ReadNumber a) = "ReadNumber " ++ (show a)
+  show (HaveNumber a) = "HaveNumber " ++ (show a)
+
+
+newtype TestSequenceState b =
+  TestSequenceState (Word32, [TestSequenceEvents], Maybe b)
+  
+instance Show (TestSequenceState ct) where
+  show (TestSequenceState (a,b,_)) =
+    "TestSequenceState " ++ (show a) ++ " " ++ (show b)
+
+newtype TestSequence b a =
+  TestSequence (TestSequenceState b -> (TestSequenceState b, a))
+
+newtype TestSVar a = TestSVar a
+
+
+instance Monad (TestSequence a) where
+  TestSequence fun >>= k =
+    TestSequence
+      (\state -> let (state', ret) = (fun state)
+                     TestSequence fun' = k ret
+                  in fun' state')
+  return ret = 
+    TestSequence $
+      \(TestSequenceState (timer, hl, testsvar)) ->
+       (TestSequenceState (timer+1,hl, testsvar), ret)
+
+runTestSequence :: Show a => TestSequence b a -> IO (TestSequenceState b, a)
+runTestSequence f = do
+  let ret = (fun (TestSequenceState (0, [], Nothing)))
+   in return ret
+  where
+    TestSequence fun = (TestSequence
+      (\(TestSequenceState (t, hl, testsvar)) ->
+        (TestSequenceState (t+1, hl, testsvar), ()))) >> f
+
+newTestSVar :: a -> TestSequence a (TestSVar a)
+newTestSVar var = TestSequence $
+  \(TestSequenceState (timer, hl, Nothing)) ->
+   (TestSequenceState (timer+1, hl, Just var), TestSVar var)
+
+enterTestSVar :: TestSVar a -> (a -> TestSequence a (a,b)) -> TestSequence a b
+enterTestSVar testsvar fun = do
+  teststate <- readTestSVar testsvar
+  (teststate',passalong) <- fun teststate
+  putTestSVar testsvar teststate'
+  return passalong
+
+-- 'putTestSVar' is used along with 'readTestSVar' to implement enterTestSVar.
+--
+putTestSVar :: TestSVar a -> a -> TestSequence a a
+putTestSVar _testsvar testsvar' = TestSequence $
+  \(TestSequenceState (timer, hl, testsvar)) ->
+   (TestSequenceState (timer+1, (PutVar timer) : hl, Just testsvar'),
+      case testsvar of
+        Nothing -> testsvar'
+        Just testsvar'' -> testsvar'')
+
+readTestSVar :: TestSVar a -> TestSequence a a
+readTestSVar _testsvar = TestSequence $
+  \(TestSequenceState (timer, hl, Just testsvar)) ->
+   (TestSequenceState (timer+1, (GetVar timer) : hl, Just testsvar), testsvar)
+
+getCurrentTime :: TestSequence a Int
+getCurrentTime = TestSequence $
+  \(TestSequenceState (timer, hl, testsvar)) ->
+   (TestSequenceState (timer+1, (GetTime timer) : hl, testsvar), fromIntegral timer)
+
+readNumber :: TestSequence a Int
+readNumber = TestSequence $
+  \(TestSequenceState (timer, hl, testsvar)) ->
+    let number = fromIntegral timer
+     in (TestSequenceState (timer+1, (ReadNumber number) : hl, testsvar), number)
+
+haveNumber :: Int -> TestSequence a ()
+haveNumber number = TestSequence $
+  \(TestSequenceState (timer, hl, testsvar)) ->
+   (TestSequenceState (timer+1, (HaveNumber number) : hl, testsvar), ())
+
+
+

+ Caching/ExpiringCacheMap/Utils/Types.hs view

@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}
+-- |
+-- Module : Caching.ExpiringCacheMap.Utils.Types
+-- Copyright: (c) 2014 Edward L. Blake
+-- License: BSD-style
+-- Maintainer: Edward L. Blake <edwardlblake@gmail.com>
+-- Stability: experimental
+-- Portability: portable
+--
+-- Simple types.
+-- 
+
+module Caching.ExpiringCacheMap.Utils.Types (
+    -- * Types
+    TimeUnits,
+    ECMMapSize,
+    ECMULength,
+    ECMIncr,
+) where
+
+import Data.Word (Word32)
+
+-- | Integer involved in the time units used to determine when an item expires.
+-- The time units used can be any arbitrary integer time representation, such
+-- as seconds or milliseconds for examples. They can also be deterministic time
+-- steps in a sequencing monad.
+--
+type TimeUnits = Int
+
+-- | Integer involved in the size of a key-value map.
+type ECMMapSize = Int
+
+-- | Integer involved in the length of the usage history list.
+type ECMULength = Int
+
+-- | Unsigned integer ('Word32') involved in the cache state incrementing accumulator.
+type ECMIncr = Word32

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2014, Edward L. Blake
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Edward L. Blake nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,7 @@+
+expiring-cache-map
+==================
+
+A general purpose simple shared state cache map with automatic expiration of
+values for caching the results of accessing a resource (such as reading a file),
+with variations for Ord and Hashable keys.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

+ expiring-cache-map.cabal view

@@ -0,0 +1,68 @@+name:                expiring-cache-map
+version:             0.0.5.0
+synopsis:            General purpose simple caching.
+description:         
+    A simple general purpose shared state cache map with automatic expiration 
+    of values, for caching the results of accessing a resource such as reading 
+    a file. With variations for Ord and Hashable keys using "Data.Map.Strict"
+    and "Data.HashMap.Strict", respectively.
+
+homepage:            https://github.com/elblake/expiring-cache-map
+bug-reports:         https://github.com/elblake/expiring-cache-map/issues
+license:             BSD3
+license-file:        LICENSE
+author:              Edward L. Blake
+maintainer:          edwardlblake@gmail.com
+copyright:           (c) 2014 Edward L. Blake
+category:            Caching
+build-type:          Simple
+cabal-version:       >=1.8
+
+extra-source-files:
+    README.md
+
+library
+  exposed-modules:
+    Caching.ExpiringCacheMap.OrdECM
+    Caching.ExpiringCacheMap.HashECM
+    Caching.ExpiringCacheMap.Internal.Internal
+    Caching.ExpiringCacheMap.Internal.Types
+    Caching.ExpiringCacheMap.Types
+    Caching.ExpiringCacheMap.Utils.TestSequence
+    Caching.ExpiringCacheMap.Utils.Types
+  -- other-modules:       
+  build-depends:       
+    base == 4.*,
+    containers >= 0.5.0.0,
+    hashable >= 1.0.1.1 && < 1.2,
+    unordered-containers >= 0.2.0.0
+
+test-suite test-threads
+    type: exitcode-stdio-1.0
+    hs-source-dirs: . tests
+    main-is: TestWithThreads.hs
+    build-depends:
+      base,
+      bytestring >= 0.10.0.0,
+      time >= 1.0,
+      containers >= 0.5.0.0,
+      hashable >= 1.0.1.1 && < 1.2,
+      unordered-containers >= 0.2.0.0
+    other-modules:
+      TestHashECMWithThreads
+      TestOrdECMWithThreads
+      Caching.ExpiringCacheMap.Internal.Internal
+
+test-suite test-sequence
+    type: exitcode-stdio-1.0
+    hs-source-dirs: . tests
+    main-is: TestWithTestSequence.hs
+    build-depends:
+      base,
+      bytestring >= 0.10.0.0,
+      containers >= 0.5.0.0,
+      hashable >= 1.0.1.1 && < 1.2,
+      unordered-containers >= 0.2.0.0
+    other-modules:
+      TestHashECMWithTestSequence
+      TestOrdECMWithTestSequence

+ tests/TestHashECMWithTestSequence.hs view

@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module TestHashECMWithTestSequence where
+
+import Caching.ExpiringCacheMap.HashECM (newECMForM, lookupECM, CacheSettings(..), consistentDuration)
+import qualified Caching.ExpiringCacheMap.Utils.TestSequence as TestSeq
+
+import qualified Data.ByteString.Char8 as BS
+
+numberEventsOnly a =
+  case a of
+    TestSeq.ReadNumber _ -> True
+    TestSeq.HaveNumber _ -> True
+    _ -> False
+
+testWithTestSequence = do
+  (TestSeq.TestSequenceState (_, events, _), return_value) <- TestSeq.runTestSequence test'
+  case (filter numberEventsOnly . reverse) events of
+    [ TestSeq.ReadNumber numr1, TestSeq.HaveNumber numh1,
+      TestSeq.ReadNumber numr2, TestSeq.HaveNumber numh2 ]
+      | numr1 == numh1 && numr2 == numh2 -> do
+        (putStrLn . show . filter numberEventsOnly . reverse) events
+        return ()
+  where
+    test' = do
+      filecache <- newECMForM
+            (consistentDuration 100 -- Duration between access and expiry time of each item, no state needed.
+              (\state _id -> do number <- TestSeq.readNumber
+                                return (state, number)))
+            (TestSeq.getCurrentTime >>= return)
+            12000 -- Time check frequency: (accumulator `mod` this_number) == 0.
+            (CacheWithLRUList 
+              6   -- Expected size of key-value map when removing elements.
+              6   -- Size of list when to remove items from key-value map.
+              12  -- Size of list when to compact
+              )
+            TestSeq.newTestSVar TestSeq.enterTestSVar TestSeq.readTestSVar
+      
+      -- Use lookupECM whenever the contents of "file1" is needed.
+      b <- lookupECM filecache ("file1" :: BS.ByteString)
+      TestSeq.haveNumber b
+      b <- lookupECM filecache "file1"
+      b <- lookupECM filecache "file2"
+      TestSeq.haveNumber b
+      return b
+
+main = testWithTestSequence
+
+

+ tests/TestHashECMWithThreads.hs view

@@ -0,0 +1,85 @@+{-# LANGUAGE OverloadedStrings #-}
+
+--
+-- Test HashECM with threads
+--
+
+module TestHashECMWithThreads where
+
+import Control.Concurrent (forkIO, threadDelay)
+import qualified Data.Time.Clock.POSIX as POSIX (POSIXTime, getPOSIXTime)
+import qualified Data.ByteString.Lazy.Char8 as LBS
+
+import qualified Control.Concurrent.MVar as MV
+import qualified Data.HashMap.Strict as HM
+import Data.Hashable (Hashable(..))
+
+import Caching.ExpiringCacheMap.HashECM
+import Caching.ExpiringCacheMap.Internal.Internal (getStatsString)
+
+testWithThreads = do
+  ecm <- newECMIO
+            (consistentDuration 10
+              (\state id -> do LBS.putStrLn id; return (state, [])))
+            (do time <- POSIX.getPOSIXTime
+                return (round (time * 100)))
+            120 
+            (CacheWithLRUList 6 6 12) :: IO (ECM IO MV.MVar () HM.HashMap LBS.ByteString [Int])
+  forkIO $ do
+    mapM_ (\a -> do
+      b <- lookupECM ecm "test.2"
+      threadDelay 2
+      return ())
+      [0..400]
+  forkIO $ do
+    mapM_ (\a -> do
+      b <- lookupECM ecm "test.5"
+      threadDelay 5
+      return ())
+      [0..300]
+  forkIO $ do
+    mapM_ (\a -> do
+      b <- lookupECM ecm "test.7"
+      threadDelay 7
+      return ())
+      [0..300]
+  forkIO $ do
+    mapM_ (\a -> do
+      b <- lookupECM ecm "test.11"
+      threadDelay 11
+      return ())
+      [0..200]
+  forkIO $ do
+    mapM_ (\a -> do
+      b <- lookupECM ecm "test.13"
+      threadDelay 13
+      return ())
+      [0..200]
+  forkIO $ do
+    mapM_ (\a -> do
+      b <- lookupECM ecm "test.17"
+      threadDelay 17
+      return ())
+      [0..200]
+  forkIO $ do
+    mapM_ (\a -> do
+      b <- lookupECM ecm "test.111"
+      threadDelay 111
+      return ())
+      [0..20]
+  forkIO $ do
+    mapM_ (\a -> do
+      b <- lookupECM ecm "test.109"
+      threadDelay 109
+      return ())
+      [0..20]
+  forkIO $ do
+    mapM_ (\a -> do
+      b <- lookupECM ecm "test.1091"
+      threadDelay 1091
+      return ())
+      [0..5]
+  threadDelay 2000000
+  c <- getStatsString ecm
+  putStrLn c
+  return ()

+ tests/TestOrdECMWithTestSequence.hs view

@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module TestOrdECMWithTestSequence where
+
+import Caching.ExpiringCacheMap.OrdECM (newECMForM, lookupECM, CacheSettings(..), consistentDuration)
+import qualified Caching.ExpiringCacheMap.Utils.TestSequence as TestSeq
+
+import qualified Data.ByteString.Char8 as BS
+
+numberEventsOnly a =
+  case a of
+    TestSeq.ReadNumber _ -> True
+    TestSeq.HaveNumber _ -> True
+    _ -> False
+
+testWithTestSequence = do
+  (TestSeq.TestSequenceState (_, events, _), return_value) <- TestSeq.runTestSequence test'
+  case (filter numberEventsOnly . reverse) events of
+    [ TestSeq.ReadNumber numr1, TestSeq.HaveNumber numh1,
+      TestSeq.ReadNumber numr2, TestSeq.HaveNumber numh2 ]
+      | numr1 == numh1 && numr2 == numh2 -> do
+        (putStrLn . show . filter numberEventsOnly . reverse) events
+        return ()
+  where
+    test' = do
+      filecache <- newECMForM
+            (consistentDuration 100 -- Duration between access and expiry time of each item, no state needed.
+              (\state _id -> do number <- TestSeq.readNumber
+                                return (state, number)))
+            (TestSeq.getCurrentTime >>= return)
+            12000 -- Time check frequency: (accumulator `mod` this_number) == 0.
+            (CacheWithLRUList 
+              6   -- Expected size of key-value map when removing elements.
+              6   -- Size of list when to remove items from key-value map.
+              12  -- Size of list when to compact
+              )
+            TestSeq.newTestSVar TestSeq.enterTestSVar TestSeq.readTestSVar
+      
+      -- Use lookupECM whenever the contents of "file1" is needed.
+      b <- lookupECM filecache ("file1" :: BS.ByteString)
+      TestSeq.haveNumber b
+      b <- lookupECM filecache "file1"
+      b <- lookupECM filecache "file2"
+      TestSeq.haveNumber b
+      return b
+
+main = testWithTestSequence
+
+

+ tests/TestOrdECMWithThreads.hs view

@@ -0,0 +1,84 @@+{-# LANGUAGE OverloadedStrings #-}
+
+--
+-- Test OrdECM with threads
+--
+
+module TestOrdECMWithThreads where
+
+import Control.Concurrent (forkIO, threadDelay)
+import qualified Data.Time.Clock.POSIX as POSIX (POSIXTime, getPOSIXTime)
+import qualified Data.ByteString.Lazy.Char8 as LBS
+
+import qualified Control.Concurrent.MVar as MV
+import qualified Data.Map as M
+
+import Caching.ExpiringCacheMap.OrdECM
+import Caching.ExpiringCacheMap.Internal.Internal (getStatsString)
+
+testWithThreads = do
+  ecm <- newECMIO
+            (consistentDuration 10
+              (\state id -> do LBS.putStrLn id; return (state, [])))
+            (do time <- POSIX.getPOSIXTime
+                return (round (time * 100)))
+            120
+            (CacheWithLRUList 6 6 12 ) :: IO (ECM IO MV.MVar () M.Map LBS.ByteString [Int])
+  forkIO $ do
+    mapM_ (\a -> do
+      b <- lookupECM ecm "test.2"
+      threadDelay 2
+      return ())
+      [0..400]
+  forkIO $ do
+    mapM_ (\a -> do
+      b <- lookupECM ecm "test.5"
+      threadDelay 5
+      return ())
+      [0..300]
+  forkIO $ do
+    mapM_ (\a -> do
+      b <- lookupECM ecm "test.7"
+      threadDelay 7
+      return ())
+      [0..300]
+  forkIO $ do
+    mapM_ (\a -> do
+      b <- lookupECM ecm "test.11"
+      threadDelay 11
+      return ())
+      [0..200]
+  forkIO $ do
+    mapM_ (\a -> do
+      b <- lookupECM ecm "test.13"
+      threadDelay 13
+      return ())
+      [0..200]
+  forkIO $ do
+    mapM_ (\a -> do
+      b <- lookupECM ecm "test.17"
+      threadDelay 17
+      return ())
+      [0..200]
+  forkIO $ do
+    mapM_ (\a -> do
+      b <- lookupECM ecm "test.111"
+      threadDelay 111
+      return ())
+      [0..20]
+  forkIO $ do
+    mapM_ (\a -> do
+      b <- lookupECM ecm "test.109"
+      threadDelay 109
+      return ())
+      [0..20]
+  forkIO $ do
+    mapM_ (\a -> do
+      b <- lookupECM ecm "test.1091"
+      threadDelay 1091
+      return ())
+      [0..5]
+  threadDelay 2000000
+  c <- getStatsString ecm
+  putStrLn c
+  return ()

+ tests/TestWithTestSequence.hs view

@@ -0,0 +1,9 @@+-- module TestWithTestSequence where
+
+import qualified TestOrdECMWithTestSequence as OrdTest
+import qualified TestHashECMWithTestSequence as HashTest
+
+main = do
+  HashTest.testWithTestSequence
+  OrdTest.testWithTestSequence
+  return ()

+ tests/TestWithThreads.hs view

@@ -0,0 +1,17 @@+{-# LANGUAGE OverloadedStrings #-}
+
+--
+-- Test with threads
+--
+
+-- module TestWithThreads where
+
+import qualified TestOrdECMWithThreads as OrdTest
+import qualified TestHashECMWithThreads as HashTest
+
+testWithThreads = do
+  HashTest.testWithThreads
+  OrdTest.testWithThreads
+  return ()
+
+main = testWithThreads