cached-io 1.1.0.0 → 1.2.0.0
raw patch · 4 files changed
+172/−71 lines, 4 filesdep +exceptionsdep ~basedep ~stmdep ~timenew-uploader
Dependencies added: exceptions
Dependency ranges changed: base, stm, time, transformers
Files
- CHANGELOG.md +16/−0
- README.md +34/−0
- cached-io.cabal +43/−44
- src/Control/Concurrent/CachedIO.hs +79/−27
+ CHANGELOG.md view
@@ -0,0 +1,16 @@+# Revision history for cached-io++## 1.2.0.0++Thank you [glasserc](https://github.com/glasserc) for your work on previous versions, and a special thanks to+[Arguggi](https://github.com/Arguggi) for contributing many of the improvements incorporated into this+version.++- [Bellroy](https://github.com/bellroy) is the new maintainer of this package. See https://github.com/glasserc/haskell-cached-io/pull/1.+- New `cachedIO'` and `cachedIOWith'` support generating an action depending on the most recent cached value and its timestamp, if there was one.+- `cachedIO ttl f` can now be run in a different monad to `f`. Similarly for `cachedIO'`, `cachedIOWith`, `cachedIOWith'`.+- Fixes uncaught exceptions leaving the cache in a deadlocked state and other problems.++## 1.1.0.0 and prior++These versions were published by [glasserc](https://github.com/glasserc).
+ README.md view
@@ -0,0 +1,34 @@+# cached-io: cache a single IO action++Sometimes you have an action that does something really expensive+whose results don't change that much. This is a simple library that+lets you cache the output of that expensive action for a+developer-specified length of time.++`test/test-cachedIO.hs` shows a very basic usage example.++## Developing this library++All standardised tooling is provided by `flake.nix`.++```shell+nix develop+```++### Formatting code++| To format | use |+| --------- | -------------------------------------------------------------------------------------------- |+| `*.cabal` | [`cabal-fmt`](https://hackage.haskell.org/package/cabal-fmt) (`cabal-fmt --inplace *.cabal`) |+| `*.nix` | [`nixpkgs-fmt`](https://github.com/nix-community/nixpkgs-fmt) (`nixpkgs-fmt *.nix`) |++We have not yet chosen a formatter for Haskell source. For now, try to follow+the style of surrounding code.++### CI++The GitHub Actions CI workflow for this repo is generated by [`haskell-ci`](https://github.com/haskell-CI/haskell-ci):++```shell+haskell-ci regenerate+```
cached-io.cabal view
@@ -1,60 +1,59 @@--- Initial cached-io.cabal generated by cabal init. For further--- documentation, see http://haskell.org/cabal/users-guide/--name: cached-io-version: 1.1.0.0-synopsis:- A simple library to cache a single IO action with timeout+cabal-version: 2.2+name: cached-io+version: 1.2.0.0+synopsis: A simple library to cache IO actions description:- A simple library that caches an expensive IO action. This produces an IO- action that, when run, either runs the expensive action and saves its result- for a period of time, or re-uses the saved value. This amortizes the cost of- the expensive IO action without a lot of complexity.+ Provides functions that convert an IO action into a cached one by storing the+ original result for a period of time, or until some condition is met. - See the test program for an example of how to use it.-license: Apache-2.0-license-file: LICENSE-author: SumAll, Inc.-maintainer: eglassercamp@sumall.com--- copyright:-category: Development-build-type: Simple--- extra-source-files:-cabal-version: >=1.10+license: Apache-2.0+license-file: LICENSE+author: SumAll, Inc.+maintainer: Bellroy Tech Team <haskell@bellroy.com>+category: Development+build-type: Simple+tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.1+extra-source-files:+ CHANGELOG.md+ README.md source-repository head- type: git- location: git://github.com:SumAll/haskell-cached-io.git+ type: git+ location: https://github.com/bellroy/haskell-cached-io.git +common deps+ build-depends: base >=4.13.0.0 && <4.18+ library- exposed-modules: Control.Concurrent.CachedIO- -- other-modules:- -- other-extensions:+ import: deps+ exposed-modules: Control.Concurrent.CachedIO build-depends:- base >= 4.8 && < 5.0,- stm,- transformers,- time- hs-source-dirs: src/- default-language: Haskell2010- ghc-options: -fwarn-unused-imports -Wall -fno-warn-unused-do-bind+ , exceptions >=0.10.4 && <0.11+ , stm >=2.5 && <2.6+ , time >=1.9.3 && <1.13+ , transformers >=0.5.6.2 && <0.7++ hs-source-dirs: src/+ default-language: Haskell2010+ ghc-options: -fwarn-unused-imports -Wall -fno-warn-unused-do-bind+ if flag(developer) ghc-options: -Werror flag developer- manual: True- default: False- description:- compile with -Werror to make warnings fatal+ manual: True+ default: False+ description: compile with -Werror to make warnings fatal executable test-cachedIO- main-is: test-cachedIO.hs- build-depends:- base >=4.8 && <5.0,- cached-io- hs-source-dirs: test/- default-language: Haskell2010- ghc-options: -threaded -rtsopts -fwarn-unused-imports -Wall+ import: deps+ main-is: test-cachedIO.hs+ build-depends: cached-io+ hs-source-dirs: test/+ default-language: Haskell2010+ ghc-options:+ -threaded -rtsopts -fwarn-unused-imports -Wall -fno-warn-unused-do-bind+ if flag(developer) ghc-options: -Werror
src/Control/Concurrent/CachedIO.hs view
@@ -1,14 +1,32 @@+-- | Example usage:+--+-- > -- Downloads a large payload from an external data store.+-- > downloadData :: IO ByteString+-- >+-- > cachedDownloadData :: IO ByteString+-- > cachedDownloadData = cachedIO (secondsToNominalDiffTime 600) downloadData+--+-- The first time @cachedDownloadData@ is called, it calls @downloadData@,+-- stores the result, and returns it. If it is called again:+--+-- * before 10 minutes have passed, it returns the stored value.+-- * after 10 minutes have passed, it calls @downloadData@ and stores the+-- result again.+-- module Control.Concurrent.CachedIO ( cachedIO,- cachedIOWith+ cachedIOWith,+ cachedIO',+ cachedIOWith' ) where -import Control.Concurrent.STM (atomically, newTVar, readTVar, writeTVar, retry)+import Control.Concurrent.STM (atomically, newTVar, readTVar, writeTVar, retry, TVar) import Control.Monad (join)+import Control.Monad.Catch (MonadCatch, onException) import Control.Monad.IO.Class (liftIO, MonadIO) import Data.Time.Clock (NominalDiffTime, addUTCTime, getCurrentTime, UTCTime) -data State = Uninitialized | Initializing+data State a = Uninitialized | Initializing | Updating a | Fresh UTCTime a -- | Cache an IO action, producing a version of this IO action that is cached -- for 'interval' seconds. The cache begins uninitialized.@@ -16,12 +34,25 @@ -- 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 :: (MonadIO m)+cachedIO :: (MonadIO m, MonadIO t, MonadCatch t) => NominalDiffTime -- ^ Number of seconds before refreshing cache- -> m a -- ^ IO action to cache- -> m (m a)+ -> t a -- ^ IO action to cache+ -> m (t a) cachedIO interval = cachedIOWith (secondsPassed interval) +-- | Cache an IO action, producing a version of this IO action that is cached+-- for 'interval' seconds. 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, if the cache is older than 'interval'+-- seconds.+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)+cachedIO' interval = cachedIOWith' (secondsPassed interval)+ -- | Check if @starting time@ + @seconds@ is after @end time@ secondsPassed :: NominalDiffTime -- ^ Seconds -> UTCTime -- ^ Start time@@ -33,39 +64,60 @@ -- -- 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)+cachedIOWith+ :: (MonadIO m, MonadIO t, MonadCatch t) => (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)))+ -> t a -- ^ action to cache.+ -> m (t a)+cachedIOWith f io = cachedIOWith' f (const io)++-- | 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, MonadIO t, MonadCatch t)+ => (UTCTime -> UTCTime -> Bool) -- ^ Test function:+ -- If 'isCacheStillFresh' 'lastUpdated' 'now' returns 'True'+ -- 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)+cachedIOWith' isCacheStillFresh io = do+ cachedT <- liftIO (atomically (newTVar Uninitialized)) return $ do now <- liftIO getCurrentTime join . liftIO . atomically $ do cached <- readTVar cachedT case cached of+ previousState@(Fresh lastUpdated value) -- There's data in the cache and it's recent. Just return.- (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- -- thread would get the stale data instead. Refresh the cache and return.- (_, Right value) -> do- writeTVar cachedT (now, Right value)- return $ refreshCache now cachedT+ | isCacheStillFresh lastUpdated now -> return (return value)+ -- There's data in the cache, but it's stale. Update the cache state+ -- to prevent a second thread from also executing the action. The second+ -- thread will get the stale data instead.+ | otherwise -> do+ writeTVar cachedT (Updating value)+ return $ 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.- (_, Left Uninitialized) -> do- writeTVar cachedT (now, Left Initializing)- return $ refreshCache now cachedT+ Uninitialized -> return $ refreshCache Uninitialized cachedT -- The cache is uninitialized and another thread is already attempting to -- initialize it. Block.- (_, Left Initializing) -> retry+ Initializing -> retry where- refreshCache now cachedT = do- newValue <- io- liftIO (atomically (writeTVar cachedT (now, Right newValue)))+ refreshCache previousState cachedT = do+ let previous = case previousState of+ Fresh lastUpdated value -> Just (lastUpdated, value)+ _ -> Nothing+ newValue <- io previous `onException` restoreState previousState cachedT+ now <- liftIO getCurrentTime+ liftIO (atomically (writeTVar cachedT (Fresh now newValue))) liftIO (return newValue)++restoreState :: (MonadIO m) => State a -> TVar (State a) -> m ()+restoreState previousState cachedT = liftIO (atomically (writeTVar cachedT previousState))