@@ -1,5 +1,6 @@
11{-# LANGUAGE BangPatterns #-}
22{-# LANGUAGE DeriveDataTypeable #-}
3+{-# LANGUAGE RecordWildCards #-}
34
45-- | A common problem is the desire to have an action run at a scheduled
56-- interval, but only if it is needed. For example, instead of having
@@ -90,9 +91,9 @@ data Status a = AutoUpdated
9091--
9192-- Since 0.1.0
9293mkAutoUpdate :: UpdateSettings a -> IO (IO a)
93−mkAutoUpdate (UpdateSettings !f !t !a) = do
94+mkAutoUpdate us = do
9495 istatus <- newIORef $ ManualUpdates 0
95− return $! getCurrent f t a istatus
96+ return $! getCurrent us istatus
9697
9798data Action a = Return a | Manual | Spawn
9899
@@ -103,26 +104,24 @@ instance Exception Replaced
103104-- computed manually in the current thread.
104105--
105106-- Since 0.1.0
106−getCurrent :: Int -- ^ frequency
107− -> Int -- ^ spawn threshold
108− -> IO a -- ^ internal update action
107+getCurrent :: UpdateSettings a
109108 -> IORef (Status a) -- ^ mutable state
110109 -> IO a
111−getCurrent freq spawnThreshold update istatus = do
110+getCurrent us@UpdateSettings{..} istatus = do
112111 ea <- atomicModifyIORef' istatus increment
113112 case ea of
114113 Return a -> return a
115− Manual -> update
114+ Manual -> updateAction
116115 Spawn -> do
117− a <- update
118− tid <- forkIO $ spawn freq update istatus
116+ a <- updateAction
117+ tid <- forkIO $ spawn us istatus
119118 join $ atomicModifyIORef' istatus $ turnToAuto a tid
120119 return a
121120 where
122121 increment (AutoUpdated a cnt tid) = (AutoUpdated a (succ cnt) tid, Return a)
123122 increment (ManualUpdates i) = (ManualUpdates (succ i), act)
124123 where
125− act = if i > spawnThreshold then Spawn else Manual
124+ act = if i > updateSpawnThreshold then Spawn else Manual
126125
127126 -- Normal case.
128127 turnToAuto a tid (ManualUpdates cnt) = (AutoUpdated a cnt tid
@@ -132,10 +131,10 @@ getCurrent freq spawnThreshold update istatus = do
132131 turnToAuto a tid (AutoUpdated _ cnt old) = (AutoUpdated a cnt tid
133132 ,throwTo old Replaced)
134133
135−spawn :: Int -> IO a -> IORef (Status a) -> IO ()
136−spawn freq update istatus = handle (onErr istatus) $ forever $ do
137− threadDelay freq
138− a <- update
134+spawn :: UpdateSettings a -> IORef (Status a) -> IO ()
135+spawn UpdateSettings{..} istatus = handle (onErr istatus) $ forever $ do
136+ threadDelay updateFreq
137+ a <- updateAction
139138 join $ atomicModifyIORef' istatus $ turnToManual a
140139 where
141140 -- Normal case.