@@ -5,12 +5,12 @@
55-- second, and write the current time to a shared 'IORef', than it is for each
66-- request to make its own call to 'getCurrentTime'.
77--
8−-- But for a low-volume server, whose request frequency is less than once per
9−-- second, that approach will result in /more/ calls to 'getCurrentTime' than
8+-- But for a low-volume server, whose request frequency is less than once per
9+-- second, that approach will result in /more/ calls to 'getCurrentTime' than
1010-- necessary, and worse, kills idle GC.
1111--
1212-- This library solves that problem by allowing you to define actions which will
13−-- either be performed by a dedicated thread, or, in times of low volume, will
13+-- either be performed by a dedicated thread, or, in times of low volume, will
1414-- be executed by the calling thread.
1515--
1616-- Example usage:
@@ -42,7 +42,8 @@ module Control.AutoUpdate (
4242import Control.Concurrent (forkIO, threadDelay)
4343import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar,
4444 takeMVar, tryPutMVar)
45−import Control.Exception (SomeException, catch, throw, mask_, try)
45+import Control.Exception (SomeException, catch, mask_, throw,
46+ try)
4647import Control.Monad (void)
4748import Data.IORef (newIORef, readIORef, writeIORef)
4849
@@ -54,6 +55,7 @@ defaultUpdateSettings = UpdateSettings
5455 { updateFreq = 1000000
5556 , updateSpawnThreshold = 3
5657 , updateAction = return ()
58+ , updateActionModify = Nothing
5759 }
5860
5961-- | Settings to control how values are updated.
@@ -90,6 +92,11 @@ data UpdateSettings a = UpdateSettings
9092 -- Default: does nothing.
9193 --
9294 -- @since 0.1.0
95+ , updateActionModify :: Maybe (a -> IO a)
96+ -- ^ Optional action to be performed to get the current value
97+ -- and updating it if necessary.
98+ --
99+ -- Default: does nothing.
93100 }
94101
95102-- | Generate an action which will either read from an automatically
@@ -140,12 +147,12 @@ mkAutoUpdate us = do
140147 -- This infinite loop makes up out worker thread. It takes an a
141148 -- responseVar value where the next value should be putMVar'ed to for
142149 -- the benefit of any requesters currently blocked on it.
143− let loop responseVar = do
150+ let loop responseVar maybea = do
144151 -- block until a value is actually needed
145152 takeMVar needsRunning
146153
147154 -- new value requested, so run the updateAction
148− a <- catchSome $ updateAction us
155+ a <- catchSome $ maybe (updateAction us) id (updateActionModify us <*> maybea)
149156
150157 -- we got a new value, update currRef and lastValue
151158 writeIORef currRef $ Right a
@@ -160,10 +167,10 @@ mkAutoUpdate us = do
160167 -- variable.
161168 responseVar' <- newEmptyMVar
162169 writeIORef currRef $ Left responseVar'
163− loop responseVar'
170+ loop responseVar' (Just a)
164171
165172 -- Kick off the loop, with the initial responseVar0 variable.
166− loop responseVar0
173+ loop responseVar0 Nothing
167174
168175 return $ do
169176 mval <- readIORef currRef