@@ -33,6 +33,7 @@ import Data.IORef (IORef, newIORef, readIORef, writeIORef)
3333import Data.Typeable (Typeable)
3434import System.IO.Unsafe (unsafePerformIO)
3535import Prelude hiding (catch)
36+import Control.Concurrent.MVar
3637
3738-- | Default value for creating an @UpdateSettings@.
3839--
@@ -94,28 +95,48 @@ data Status a = AutoUpdated
9495-- Since 0.1.0
9596mkAutoUpdate :: UpdateSettings a -> IO (IO a)
9697mkAutoUpdate us = do
97− used <- newIORef False
98− ref <- newIORef $ error "mkAutoUpdate"
99− writeIORef ref $ unsafePerformIO $ start us used ref
98+ -- The current value, if available.
99+ currRef <- newIORef Nothing
100+
101+ -- A baton to tell the worker thread to generate a new value.
102+ needsRunning <- newEmptyMVar
103+
104+ -- The last value generated, to allow for blocking semantics when currRef
105+ -- is Nothing.
106+ lastValue <- newEmptyMVar
107+
108+ -- fork the worker thread immediately...
109+ void $ forkIO $ forever $ do
110+ -- but block until a value is actually needed
111+ takeMVar needsRunning
112+
113+ -- new value requested, so run the updateAction
114+ a <- catchSome $ updateAction us
115+
116+ -- we got a new value, update currRef and lastValue
117+ writeIORef currRef $ Just a
118+ void $ tryTakeMVar lastValue
119+ putMVar lastValue a
120+
121+ -- delay until we're needed again
122+ threadDelay $ updateFreq us
123+
124+ -- delay's over, clear out currRef and lastValue so that demanding the
125+ -- value again forces us to start work
126+ writeIORef currRef Nothing
127+ void $ takeMVar lastValue
128+
100129 return $ do
101− writeIORef used True
102− readIORef ref
103−
104−start settings@UpdateSettings{..} used ref = do
105− a <- updateAction
106− void $ forkIO $
107− let loop = do
108− threadDelay updateFreq
109− used' <- readIORef used
110− if used'
111− then do
112− writeIORef used False
113− a <- catchSome updateAction
114− writeIORef ref a
115− loop
116− else writeIORef ref $ unsafePerformIO $ start settings used ref
117− in loop
118− return a
130+ mval <- readIORef currRef
131+ case mval of
132+ -- we have a current value, use it
133+ Just val -> return val
134+ Nothing -> do
135+ -- no current value, force the worker thread to run...
136+ void $ tryPutMVar needsRunning ()
137+
138+ -- and block for the result from the worker
139+ readMVar lastValue
119140
120141catchSome :: IO a -> IO a
121142catchSome act = catch act $ \e -> return $ throw (e :: SomeException)