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,9 +1,10 @@
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
 -- | Example usage:
 --
 -- > -- Downloads a large payload from an external data store.
 -- > downloadData :: IO ByteString
 -- >
--- > cachedDownloadData :: IO ByteString
+-- > cachedDownloadData :: IO (Cached IO ByteString)
 -- > cachedDownloadData = cachedIO (secondsToNominalDiffTime 600) downloadData
 --
 -- The first time @cachedDownloadData@ is called, it calls @downloadData@,
@@ -14,6 +15,7 @@
 -- result again.
 --
 module Control.Concurrent.CachedIO (
+    Cached(..),
     cachedIO,
     cachedIOWith,
     cachedIO',
@@ -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 in some monad @m@. Use 'runCached' to extract the action when you want to query it.
+--
+-- This newtype is intended to make it harder to accidentally 'Control.Monad.join' (and defeat all caching) when the fetch action and the outer monad are the same.
+newtype Cached t a = Cached {runCached :: t a}
+
 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,10 +91,10 @@ 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
+  pure . Cached $ do
     now <- liftIO getCurrentTime
     join . liftIO . atomically $ do
       cached <- readTVar cachedT
@@ -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
+            pure (refreshCache previousState cachedT)
         -- Another thread is already updating the cache, just return the stale value
-        Updating value -> return (return value)
+        Updating value -> pure (pure value)
         -- The cache is uninitialized. Mark the cache as initializing to block other
         -- threads. Initialize and return.
-        Uninitialized -> return $ refreshCache Uninitialized cachedT
+        Uninitialized -> pure (refreshCache Uninitialized cachedT)
         -- The cache is uninitialized and another thread is already attempting to
         -- initialize it. Block.
         Initializing -> retry

test/test-cachedIO.hs

@@ -2,7 +2,7 @@ module Main (
     main
     ) where
 
-import Control.Concurrent.CachedIO (cachedIO)
+import Control.Concurrent.CachedIO (cachedIO, Cached(..))
 import Data.List (isInfixOf)
 
 crawlTheInternet :: IO [String]
@@ -13,10 +13,10 @@ crawlTheInternet = do
     return ["website about Haskell", "website about Ruby", "slashdot.org",
             "The Monad.Reader", "haskellwiki"]
 
-searchEngine :: String -> IO [String] -> IO [String]
+searchEngine :: String -> Cached IO [String] -> IO [String]
 searchEngine query internet = do
-    pages <- internet
-    return $ filter (query `isInfixOf`) pages
+    pages <- runCached internet
+    return $ filter ( query `isInfixOf`) pages
 
 main :: IO ()
 main = do