cached-io 0.1.1.0 → 1.1.0.0

raw patch · 3 files changed

+46/−21 lines, 3 filesdep +cached-iodep +transformersdep ~basenew-uploader

Dependencies added: cached-io, transformers

Dependency ranges changed: base

Files

• cached-io.cabal +7/−8
• src/Control/Concurrent/CachedIO.hs +35/−13
• test/test-cachedIO.hs +4/−0

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                cached-io-version:             0.1.1.0+version:             1.1.0.0 synopsis:   A simple library to cache a single IO action with timeout description:@@ -31,13 +31,13 @@   -- other-modules:   -- other-extensions:   build-depends:-    base >=4.7 && <4.8,+    base >= 4.8 && < 5.0,     stm,+    transformers,     time   hs-source-dirs:      src/   default-language:    Haskell2010-  ghc-options: -rtsopts -fwarn-unused-imports -Wall-      -fno-warn-unused-do-bind+  ghc-options: -fwarn-unused-imports -Wall -fno-warn-unused-do-bind   if flag(developer)     ghc-options: -Werror @@ -50,10 +50,9 @@ executable test-cachedIO   main-is: test-cachedIO.hs   build-depends:-    base >=4.7 && <4.8,-    stm,-    time-  hs-source-dirs:      src/, test/+    base >=4.8 && <5.0,+    cached-io+  hs-source-dirs:      test/   default-language:    Haskell2010   ghc-options: -threaded -rtsopts -fwarn-unused-imports -Wall     -fno-warn-unused-do-bind

@@ -1,10 +1,12 @@ module Control.Concurrent.CachedIO (-    cachedIO+    cachedIO,+    cachedIOWith     ) where  import Control.Concurrent.STM (atomically, newTVar, readTVar, writeTVar, retry) import Control.Monad (join)-import Data.Time.Clock (NominalDiffTime, addUTCTime, getCurrentTime)+import Control.Monad.IO.Class (liftIO, MonadIO)+import Data.Time.Clock (NominalDiffTime, addUTCTime, getCurrentTime, UTCTime)  data State = Uninitialized | Initializing @@ -14,17 +16,39 @@ -- The outer IO is responsible for setting up the cache. Use the inner one to -- either get the cached value or refresh, if the cache is older than 'interval' -- seconds.-cachedIO :: NominalDiffTime -> IO a -> IO (IO a)-cachedIO interval io = do-  initTime <- getCurrentTime-  cachedT <- atomically (newTVar (initTime, Left Uninitialized))+cachedIO :: (MonadIO m)+         => NominalDiffTime -- ^ Number of seconds before refreshing cache+         -> m a             -- ^ IO action to cache+         -> m (m a)+cachedIO interval = cachedIOWith (secondsPassed interval)++-- | Check if @starting time@ + @seconds@ is after @end time@+secondsPassed :: NominalDiffTime  -- ^ Seconds+               -> UTCTime         -- ^ Start time+               -> UTCTime         -- ^ End time+               -> Bool+secondsPassed interval start end = addUTCTime interval start > end++-- | Cache an IO action, The cache begins uninitialized.+--+-- The outer IO is responsible for setting up the cache. Use the inner one to+-- either get the cached value or refresh+cachedIOWith :: (MonadIO m)+    => (UTCTime -> UTCTime -> Bool) -- ^ Test function:+    --   If 'isCacheStillFresh' 'lastUpdated' 'now' returns 'True'+    --   the cache is considered still fresh and returns the cached IO action+    -> m a                          -- ^ action to cache+    -> m (m a)+cachedIOWith isCacheStillFresh io = do+  initTime <- liftIO getCurrentTime+  cachedT <- liftIO (atomically (newTVar (initTime, Left Uninitialized)))   return $ do-    now <- getCurrentTime-    join . atomically $ do+    now <- liftIO getCurrentTime+    join . liftIO . atomically $ do       cached <- readTVar cachedT       case cached of         -- There's data in the cache and it's recent. Just return.-        (lastUpdated, Right value) | addUTCTime interval lastUpdated > now ->+        (lastUpdated, Right value) | isCacheStillFresh lastUpdated now ->           return (return value)         -- There's data in the cache, but it's stale. Update the cache timestamp         -- to prevent a second thread from also executing the IO action. The second@@ -43,7 +67,5 @@   where     refreshCache now cachedT = do       newValue <- io-      atomically (writeTVar cachedT (now, Right newValue))-      return newValue--+      liftIO (atomically (writeTVar cachedT (now, Right newValue)))+      liftIO (return newValue)

@@ -1,3 +1,7 @@+module Main (+    main+    ) where+ import Control.Concurrent.CachedIO (cachedIO) import Data.List (isInfixOf)