@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
12-- | In a multithreaded environment, running actions on a regularly scheduled
23-- background thread can dramatically improve performance.
34-- For example, web servers need to return the current time with each HTTP response.
@@ -37,12 +38,17 @@ module Control.AutoUpdate (
3738 , updateSpawnThreshold
3839 -- * Creation
3940 , mkAutoUpdate
41+ , mkAutoUpdateWithModify
4042 ) where
4143
44+#if __GLASGOW_HASKELL__ < 709
45+import Control.Applicative ((<*>))
46+#endif
4247import Control.Concurrent (forkIO, threadDelay)
4348import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar,
4449 takeMVar, tryPutMVar)
45−import Control.Exception (SomeException, catch, throw, mask_, try)
50+import Control.Exception (SomeException, catch, mask_, throw,
51+ try)
4652import Control.Monad (void)
4753import Data.IORef (newIORef, readIORef, writeIORef)
4854
@@ -97,7 +103,16 @@ data UpdateSettings a = UpdateSettings
97103--
98104-- @since 0.1.0
99105mkAutoUpdate :: UpdateSettings a -> IO (IO a)
100−mkAutoUpdate us = do
106+mkAutoUpdate us = mkAutoUpdateHelper us Nothing
107+
108+-- | Generate an action which will either read from an automatically
109+-- updated value, or run the update action in the current thread if
110+-- the first time or the provided modify action after that.
111+mkAutoUpdateWithModify :: UpdateSettings a -> (a -> IO a) -> IO (IO a)
112+mkAutoUpdateWithModify us f = mkAutoUpdateHelper us (Just f)
113+
114+mkAutoUpdateHelper :: UpdateSettings a -> Maybe (a -> IO a) -> IO (IO a)
115+mkAutoUpdateHelper us updateActionModify = do
101116 -- A baton to tell the worker thread to generate a new value.
102117 needsRunning <- newEmptyMVar
103118
@@ -140,12 +155,12 @@ mkAutoUpdate us = do
140155 -- This infinite loop makes up out worker thread. It takes an a
141156 -- responseVar value where the next value should be putMVar'ed to for
142157 -- the benefit of any requesters currently blocked on it.
143− let loop responseVar = do
158+ let loop responseVar maybea = do
144159 -- block until a value is actually needed
145160 takeMVar needsRunning
146161
147162 -- new value requested, so run the updateAction
148− a <- catchSome $ updateAction us
163+ a <- catchSome $ maybe (updateAction us) id (updateActionModify <*> maybea)
149164
150165 -- we got a new value, update currRef and lastValue
151166 writeIORef currRef $ Right a
@@ -160,10 +175,10 @@ mkAutoUpdate us = do
160175 -- variable.
161176 responseVar' <- newEmptyMVar
162177 writeIORef currRef $ Left responseVar'
163− loop responseVar'
178+ loop responseVar' (Just a)
164179
165180 -- Kick off the loop, with the initial responseVar0 variable.
166− loop responseVar0
181+ loop responseVar0 Nothing
167182
168183 return $ do
169184 mval <- readIORef currRef