alarmclock 0.2.0.6 → 0.2.0.7

raw patch · 2 files changed

+26/−11 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• alarmclock.cabal +1/−1
• src/Control/Concurrent/AlarmClock.hs +25/−10

@@ -1,5 +1,5 @@ name:                alarmclock-version:             0.2.0.6+version:             0.2.0.7 synopsis:            Wake up and perform an action at a certain time. description:         Wake up and perform an action at a certain time. homepage:            https://bitbucket.org/davecturner/alarmclock

@@ -55,7 +55,18 @@     -- so it can set a new alarm if desired. Note that `setAlarm` must be called once     -- the alarm has gone off to cause it to go off again.   -> IO AlarmClock-newAlarmClock onWakeUp = do+newAlarmClock onWakeUp = newAlarmClock' $ const . onWakeUp++{-| Create a new 'AlarmClock' that runs the given action. Initially, there is+no wakeup time set: you must call 'setAlarm' for anything else to happen. -}+newAlarmClock'+  :: (AlarmClock -> UTCTime -> IO ())+    -- ^ Action to run when the alarm goes off. The action is provided the alarm clock+    -- so it can set a new alarm if desired, and the current time.+    -- Note that `setAlarm` must be called once the alarm has gone off to cause+    -- it to go off again.+  -> IO AlarmClock+newAlarmClock' onWakeUp = do   joinVar <- newEmptyMVar   ac <- atomically $ AlarmClock (readMVar joinVar) <$> newTVar AlarmNotSet <*> newTVar False   void $ forkIO $ runAlarmClock ac (onWakeUp ac) `finally` putMVar joinVar ()@@ -99,7 +110,7 @@ labelMyThread :: String -> IO () labelMyThread threadLabel = myThreadId >>= flip labelThread threadLabel -runAlarmClock :: AlarmClock -> IO () -> IO ()+runAlarmClock :: AlarmClock -> (UTCTime -> IO ()) -> IO () runAlarmClock AlarmClock{..} wakeUpAction = labelMyThread "alarmclock" >> loop   where   loop = readNextSetting >>= go@@ -116,14 +127,18 @@   go (Just wakeUpTime) = wakeNoLaterThan wakeUpTime    wakeNoLaterThan wakeUpTime = do-    dt <- ceiling <$> (1000000 *) <$> diffUTCTime wakeUpTime <$> getCurrentTime-    if dt <= 0-      then actAndContinue-      else timeout dt readNextSetting >>= \case-            Nothing -> actAndContinue-            Just newSetting -> go newSetting+    currentTime <- getCurrentTime+    let dt = ceiling $ (1000000 *) $ diffUTCTime wakeUpTime currentTime+    safeTimeout dt readNextSetting >>= \case+      Nothing -> actAndContinue currentTime+      Just newSetting -> go newSetting -  actAndContinue = do+  -- Times out immediately if the duration is negative (unlike 'timeout' which waits forever)+  safeTimeout dt action+    | dt > 0    = timeout dt action+    | otherwise = return Nothing++  actAndContinue currentTime = do     atomically $ writeTVar acIsSet False-    wakeUpAction+    wakeUpAction currentTime     loop