Add Cached newtype

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

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

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