auto-update 0.1.1.4 → 0.1.1.5
raw patch · 2 files changed
+67/−33 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Control/AutoUpdate.hs +65/−32
- auto-update.cabal +2/−1
Control/AutoUpdate.hs view
@@ -1,6 +1,3 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE RecordWildCards #-}- -- | A common problem is the desire to have an action run at a scheduled -- interval, but only if it is needed. For example, instead of having -- every web request result in a new @getCurrentTime@ call, we'd like to@@ -25,9 +22,9 @@ import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar,- takeMVar, tryPutMVar, tryTakeMVar)-import Control.Exception (SomeException, catch, throw)-import Control.Monad (forever, void)+ takeMVar, tryPutMVar)+import Control.Exception (SomeException, catch, throw, mask_, try)+import Control.Monad (void) import Data.IORef (newIORef, readIORef, writeIORef) -- | Default value for creating an @UpdateSettings@.@@ -82,48 +79,84 @@ -- Since 0.1.0 mkAutoUpdate :: UpdateSettings a -> IO (IO a) mkAutoUpdate us = do- -- The current value, if available.- currRef <- newIORef Nothing- -- A baton to tell the worker thread to generate a new value. needsRunning <- newEmptyMVar - -- The last value generated, to allow for blocking semantics when currRef- -- is Nothing.- lastValue <- newEmptyMVar+ -- The initial response variable. Response variables allow the requesting+ -- thread to block until a value is generated by the worker thread.+ responseVar0 <- newEmptyMVar - -- fork the worker thread immediately...- void $ forkIO $ forever $ do- -- but block until a value is actually needed- takeMVar needsRunning+ -- The current value, if available. We start off with a Left value+ -- indicating no value is available, and the above-created responseVar0 to+ -- give a variable to block on.+ currRef <- newIORef $ Left responseVar0 - -- new value requested, so run the updateAction- a <- catchSome $ updateAction us+ -- This is used to set a value in the currRef variable when the worker+ -- thread exits. In reality, that value should never be used, since the+ -- worker thread exiting only occurs if an async exception is thrown, which+ -- should only occur if there are no references to needsRunning left.+ -- However, this handler will make error messages much clearer if there's a+ -- bug in the implementation.+ let fillRefOnExit f = do+ eres <- try f+ case eres of+ Left e -> writeIORef currRef $ error $+ "Control.AutoUpdate.mkAutoUpdate: worker thread exited with exception: "+ ++ show (e :: SomeException)+ Right () -> writeIORef currRef $ error $+ "Control.AutoUpdate.mkAutoUpdate: worker thread exited normally, "+ ++ "which should be impossible due to usage of infinite loop" - -- we got a new value, update currRef and lastValue- writeIORef currRef $ Just a- void $ tryTakeMVar lastValue- putMVar lastValue a+ -- fork the worker thread immediately. Note that we mask async exceptions,+ -- but *not* in an uninterruptible manner. This will allow a+ -- BlockedIndefinitelyOnMVar exception to still be thrown, which will take+ -- down this thread when all references to the returned function are+ -- garbage collected, and therefore there is no thread that can fill the+ -- needsRunning MVar.+ --+ -- Note that since we throw away the ThreadId of this new thread and never+ -- calls myThreadId, normal async exceptions can never be thrown to it,+ -- only RTS exceptions.+ mask_ $ void $ forkIO $ fillRefOnExit $ do+ -- This infinite loop makes up out worker thread. It takes an a+ -- responseVar value where the next value should be putMVar'ed to for+ -- the benefit of any requesters currently blocked on it.+ let loop responseVar = do+ -- block until a value is actually needed+ takeMVar needsRunning - -- delay until we're needed again- threadDelay $ updateFreq us+ -- new value requested, so run the updateAction+ a <- catchSome $ updateAction us - -- delay's over, clear out currRef and lastValue so that demanding the- -- value again forces us to start work- writeIORef currRef Nothing- void $ takeMVar lastValue+ -- we got a new value, update currRef and lastValue+ writeIORef currRef $ Right a+ putMVar responseVar a + -- delay until we're needed again+ threadDelay $ updateFreq us++ -- delay's over. create a new response variable and set currRef+ -- to use it, so that the next requester will block on that+ -- variable. Then loop again with the updated response+ -- variable.+ responseVar' <- newEmptyMVar+ writeIORef currRef $ Left responseVar'+ loop responseVar'++ -- Kick off the loop, with the initial responseVar0 variable.+ loop responseVar0+ return $ do mval <- readIORef currRef case mval of- -- we have a current value, use it- Just val -> return val- Nothing -> do+ Left responseVar -> do -- no current value, force the worker thread to run... void $ tryPutMVar needsRunning () -- and block for the result from the worker- readMVar lastValue+ readMVar responseVar+ -- we have a current value, use it+ Right val -> return val -- | Turn a runtime exception into an impure exception, so that all @IO@ -- actions will complete successfully. This simply defers the exception until
auto-update.cabal view
@@ -1,5 +1,5 @@ name: auto-update-version: 0.1.1.4+version: 0.1.1.5 synopsis: Efficiently run periodic, on-demand actions description: A common problem is the desire to have an action run at a scheduled interval, but only if it is needed. For example, instead of having every web request result in a new @getCurrentTime@ call, we'd like to have a single worker thread run every second, updating an @IORef@. However, if the request frequency is less than once per second, this is a pessimization, and worse, kills idle GC.@@ -16,6 +16,7 @@ cabal-version: >=1.10 library+ ghc-options: -Wall exposed-modules: Control.AutoUpdate Control.Reaper other-modules: Control.AutoUpdate.Util