diff --git a/CHANGELOG.md b/CHANGELOG.md index 9d38923..f1750c5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for cached-io +## 1.3.0.0 + +- Caching functions previously returned `m (t a)`, but it was easy to accidentally use `join` when `m` and `t` were the same monad (eg. `IO (IO a)`), and not get any caching at all. These functions now use a `Cached` newtype for `t a` to make it harder to do this. + ## 1.2.0.0 Thank you [glasserc](https://github.com/glasserc) for your work on previous versions, and a special thanks to diff --git a/cached-io.cabal b/cached-io.cabal index 2787005..52093e9 100644 --- a/cached-io.cabal +++ b/cached-io.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: cached-io -version: 1.2.0.0 +version: 1.3.0.0 synopsis: A simple library to cache IO actions description: Provides functions that convert an IO action into a cached one by storing the diff --git a/src/Control/Concurrent/CachedIO.hs b/src/Control/Concurrent/CachedIO.hs index e20d015..1a3e446 100644 --- a/src/Control/Concurrent/CachedIO.hs +++ b/src/Control/Concurrent/CachedIO.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE GeneralisedNewtypeDeriving #-} -- | Example usage: -- -- > -- Downloads a large payload from an external data store. @@ -17,7 +18,8 @@ module Control.Concurrent.CachedIO ( cachedIO, cachedIOWith, cachedIO', - cachedIOWith' + cachedIOWith', + Cached(..) ) where import Control.Concurrent.STM (atomically, newTVar, readTVar, writeTVar, retry, TVar) @@ -26,6 +28,11 @@ import Control.Monad.Catch (MonadCatch, onException) import Control.Monad.IO.Class (liftIO, MonadIO) import Data.Time.Clock (NominalDiffTime, addUTCTime, getCurrentTime, UTCTime) +-- | A cached IO action. This newtype is intended to prevent the use of `join` when the caching action +-- and the outer monad have the same type. +newtype Cached t a = Cached {runCached :: t a} + deriving (Functor, Applicative, Monad, MonadIO) + data State a = Uninitialized | Initializing | Updating a | Fresh UTCTime a -- | Cache an IO action, producing a version of this IO action that is cached @@ -37,7 +44,7 @@ data State a = Uninitialized | Initializing | Updating a | Fresh UTCTime a cachedIO :: (MonadIO m, MonadIO t, MonadCatch t) => NominalDiffTime -- ^ Number of seconds before refreshing cache -> t a -- ^ IO action to cache - -> m (t a) + -> m (Cached t a) cachedIO interval = cachedIOWith (secondsPassed interval) -- | Cache an IO action, producing a version of this IO action that is cached @@ -50,7 +57,7 @@ cachedIO' :: (MonadIO m, MonadIO t, MonadCatch t) => NominalDiffTime -- ^ Number of seconds before refreshing cache -> (Maybe (UTCTime, a) -> t a) -- ^ action to cache. The stale value and its refresh date -- are passed so that the action can perform external staleness checks - -> m (t a) + -> m (Cached t a) cachedIO' interval = cachedIOWith' (secondsPassed interval) -- | Check if @starting time@ + @seconds@ is after @end time@ @@ -70,7 +77,7 @@ cachedIOWith -- If 'isCacheStillFresh' 'lastUpdated' 'now' returns 'True' -- the cache is considered still fresh and returns the cached IO action -> t a -- ^ action to cache. - -> m (t a) + -> m (Cached t a) cachedIOWith f io = cachedIOWith' f (const io) -- | Cache an IO action, The cache begins uninitialized. @@ -84,7 +91,7 @@ cachedIOWith' -- the cache is considered still fresh and returns the cached IO action -> (Maybe (UTCTime, a) -> t a) -- ^ action to cache. The stale value and its refresh date -- are passed so that the action can perform external staleness checks - -> m (t a) + -> m (Cached t a) cachedIOWith' isCacheStillFresh io = do cachedT <- liftIO (atomically (newTVar Uninitialized)) return $ do @@ -100,12 +107,12 @@ cachedIOWith' isCacheStillFresh io = do -- thread will get the stale data instead. | otherwise -> do writeTVar cachedT (Updating value) - return $ refreshCache previousState cachedT + return . Cached $ refreshCache previousState cachedT -- Another thread is already updating the cache, just return the stale value Updating value -> return (return value) -- The cache is uninitialized. Mark the cache as initializing to block other -- threads. Initialize and return. - Uninitialized -> return $ refreshCache Uninitialized cachedT + Uninitialized -> return . Cached $ refreshCache Uninitialized cachedT -- The cache is uninitialized and another thread is already attempting to -- initialize it. Block. Initializing -> retry