alarmclock 0.6.0.2 → 0.7.0.1
raw patch · 3 files changed
+183/−136 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- alarmclock.cabal +2/−2
- src/Control/Concurrent/AlarmClock.hs +5/−3
- test/Spec.hs +176/−131
alarmclock.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 44a47bdfae866e267373a17e05a860171ce7403ef47d41b0661cfef2a6c7ca2c+-- hash: d74c70148c171d47980440b9ddfe657d30d2c024c58bad0dd5838f12a505554d name: alarmclock-version: 0.6.0.2+version: 0.7.0.1 synopsis: Wake up and perform an action at a certain time. description: Please see the README on Bitbucket at <https://bitbucket.org/davecturner/alarmclock#readme> category: Concurrency
src/Control/Concurrent/AlarmClock.hs view
@@ -44,10 +44,10 @@ writeTVar) import Control.Concurrent.Thread.Delay (delay) import Control.Exception (bracket)+import Control.Monad (join) import Control.Monad.Fix (mfix) import GHC.Conc (labelThread, myThreadId)-import Control.Monad (join) import Control.Concurrent.AlarmClock.TimeScale @@ -144,7 +144,7 @@ let microsecondsTimeout = microsecondsDiff wakeUpTime now if 0 < microsecondsTimeout then join $ withAsync (delay microsecondsTimeout) $ \a -> atomically $- waitSTM a >> return (whenSet wakeUpTime)+ (waitSTM a >> return (whenSet wakeUpTime)) `orElse` (readTVar acNewSetting >>= \case AlarmSet wakeUpTime' | earlierOf wakeUpTime' wakeUpTime /= wakeUpTime -> return $ whenSet wakeUpTime'@@ -153,6 +153,8 @@ ) else do- atomically $ writeTVar acNewSetting AlarmNotSet+ atomically $ modifyTVar' acNewSetting $ \case+ AlarmSet _ -> AlarmNotSet+ setting -> setting wakeUpAction now loop
test/Spec.hs view
@@ -12,6 +12,7 @@ import Data.IORef import Data.Proxy import Data.Time+import System.Clock main :: IO () main = hspec $ describe "Control.Concurrent.AlarmClock" $ do@@ -54,145 +55,189 @@ atomically $ guard . not =<< isAlarmSetSTM ac threadDelay 50000 -- alarm becomes unset before action has completed - it "wakes up immediately on setAlarmNow" $ do- (writeLog, readLog) <- makeLog- withAlarmClock (\_ _ -> writeLog "alarm went off") $ \ac -> do- setAlarmNow (ac :: AlarmClock UTCTime)- threadDelay 100000- readLog `shouldReturn` ["alarm went off"]+ alarmClockSpec :: (TimeScale t, Eq t, Show t)+ => (AlarmClock t -> AlarmClock t) -> (Double -> t -> t) -> Spec+ alarmClockSpec acid addTime = do - it "wakes up a bit later using setAlarm" $ do- (writeLog, readLog) <- makeLog- withAlarmClock (\_ _ -> writeLog "alarm went off") $ \ac -> do- setAlarm ac . addUTCTime 0.2 =<< getCurrentTime- writeLog "waiting"- threadDelay 100000- writeLog "still waiting"- threadDelay 200000- writeLog "should have gone off by now"- readLog `shouldReturn`- [ "waiting"- , "still waiting"- , "alarm went off"- , "should have gone off by now"- ]+ it "wakes up immediately on setAlarmNow" $ do+ (writeLog, readLog) <- makeLog+ withAlarmClock (\_ _ -> writeLog "alarm went off") $ \ac -> do+ setAlarmNow $ acid ac+ threadDelay 100000+ readLog `shouldReturn` ["alarm went off"] - it "wakes up at the earliest set time and no others" $ do- (writeLog, readLog) <- makeLog- withAlarmClock (\_ _ -> writeLog "alarm went off") $ \ac -> do- setAlarm ac . addUTCTime 0.3 =<< getCurrentTime- setAlarm ac . addUTCTime 0.2 =<< getCurrentTime- writeLog "waiting"- threadDelay 100000- writeLog "still waiting"- threadDelay 300000- writeLog "should have gone off once by now"- readLog `shouldReturn`- [ "waiting"- , "still waiting"- , "alarm went off"- , "should have gone off once by now"- ]+ it "wakes up a bit later using setAlarm" $ do+ (writeLog, readLog) <- makeLog+ withAlarmClock (\_ _ -> writeLog "alarm went off") $ \ac -> do+ setAlarm ac . addTime 0.2 =<< getAbsoluteTime+ writeLog "waiting"+ threadDelay 100000+ writeLog "still waiting"+ threadDelay 200000+ writeLog "should have gone off by now"+ readLog `shouldReturn`+ [ "waiting"+ , "still waiting"+ , "alarm went off"+ , "should have gone off by now"+ ] - it "reports whether it is set or not" $ do- (writeLog, readLog) <- makeLog- withAlarmClock (\_ _ -> writeLog "alarm went off") $ \ac -> do- let logIfSet = do- currentlySet <- isAlarmSet ac- writeLog $ if currentlySet then "alarm is set" else "alarm is not set"- logIfSet- setAlarm ac . addUTCTime 0.2 =<< getCurrentTime- logIfSet- writeLog "waiting"- threadDelay 100000- writeLog "still waiting"- logIfSet- threadDelay 200000- writeLog "should have gone off by now"- logIfSet- readLog `shouldReturn`- [ "alarm is not set"- , "alarm is set"- , "waiting"- , "still waiting"- , "alarm is set"- , "alarm went off"- , "should have gone off by now"- , "alarm is not set"- ]+ it "wakes up at the earliest set time and no others" $ do+ (writeLog, readLog) <- makeLog+ withAlarmClock (\_ _ -> writeLog "alarm went off") $ \ac -> do+ setAlarm ac . addTime 0.4 =<< getAbsoluteTime+ setAlarm ac . addTime 0.2 =<< getAbsoluteTime+ writeLog "waiting"+ threadDelay 100000+ writeLog "still waiting"+ threadDelay 200000+ writeLog "should have gone off once by now"+ threadDelay 200000+ writeLog "should not have gone off again"+ readLog `shouldReturn`+ [ "waiting"+ , "still waiting"+ , "alarm went off"+ , "should have gone off once by now"+ , "should not have gone off again"+ ] - it "works within the STM monad" $ do- (writeLog, readLog) <- makeLog- withAlarmClock (\_ _ -> writeLog "alarm went off") $ \ac -> do- now <- getCurrentTime- atomically $ do- guard . not =<< isAlarmSetSTM ac- setAlarmSTM ac $ addUTCTime 0.1 now- guard =<< isAlarmSetSTM ac- writeLog "alarm is set"- waitUntilUnset ac- writeLog "alarm now not set again"- readLog `shouldReturn`- [ "alarm is set"- , "alarm went off"- , "alarm now not set again"- ]+ it "reports whether it is set or not" $ do+ (writeLog, readLog) <- makeLog+ withAlarmClock (\_ _ -> writeLog "alarm went off") $ \ac -> do+ let logIfSet = do+ currentlySet <- isAlarmSet ac+ writeLog $ if currentlySet then "alarm is set" else "alarm is not set"+ logIfSet+ setAlarm ac . addTime 0.2 =<< getAbsoluteTime+ logIfSet+ writeLog "waiting"+ threadDelay 100000+ writeLog "still waiting"+ logIfSet+ threadDelay 200000+ writeLog "should have gone off by now"+ logIfSet+ readLog `shouldReturn`+ [ "alarm is not set"+ , "alarm is set"+ , "waiting"+ , "still waiting"+ , "alarm is set"+ , "alarm went off"+ , "should have gone off by now"+ , "alarm is not set"+ ] - it "can be set again once it goes off" $ do- (writeLog, readLog) <- makeLog- withAlarmClock (\_ _ -> writeLog "alarm went off") $ \ac -> do- startTime <- getCurrentTime- setAlarm ac $ addUTCTime 0.1 startTime- writeLog "alarm is set"- waitUntilUnset ac- writeLog "alarm is not set"- setAlarm ac $ addUTCTime 0.2 startTime- writeLog "alarm is set"- waitUntilUnset ac- writeLog "alarm is not set"- readLog `shouldReturn`- [ "alarm is set"- , "alarm went off"- , "alarm is not set"- , "alarm is set"- , "alarm went off"- , "alarm is not set"- ]+ it "works within the STM monad" $ do+ (writeLog, readLog) <- makeLog+ withAlarmClock (\_ _ -> writeLog "alarm went off") $ \ac -> do+ now <- getAbsoluteTime+ atomically $ do+ guard . not =<< isAlarmSetSTM ac+ setAlarmSTM ac $ addTime 0.1 now+ guard =<< isAlarmSetSTM ac+ writeLog "alarm is set"+ waitUntilUnset ac+ writeLog "alarm now not set again"+ readLog `shouldReturn`+ [ "alarm is set"+ , "alarm went off"+ , "alarm now not set again"+ ] - it "goes off immediately if set to go off in the past" $ do- (writeLog, readLog) <- makeLog- withAlarmClock (\_ _ -> writeLog "alarm went off") $ \ac -> do- startTime <- getCurrentTime- setAlarm ac $ addUTCTime (-0.1) startTime- writeLog "alarm is set"- waitUntilUnset ac- writeLog "done"- endTime <- getCurrentTime- diffUTCTime endTime startTime `shouldSatisfy` (\t -> 0.0 <= t && t < 0.1)- readLog `shouldReturn`- [ "alarm is set"- , "alarm went off"- , "done"- ]+ it "can be set again once it goes off" $ do+ (writeLog, readLog) <- makeLog+ withAlarmClock (\_ _ -> writeLog "alarm went off") $ \ac -> do+ startTime <- getAbsoluteTime+ setAlarm ac $ addTime 0.1 startTime+ writeLog "alarm is set"+ waitUntilUnset ac+ writeLog "alarm is not set"+ setAlarm ac $ addTime 0.2 startTime+ writeLog "alarm is set"+ waitUntilUnset ac+ writeLog "alarm is not set"+ readLog `shouldReturn`+ [ "alarm is set"+ , "alarm went off"+ , "alarm is not set"+ , "alarm is set"+ , "alarm went off"+ , "alarm is not set"+ ] - it "blocks destruction if the alarm is going off" $ do- (writeLog, readLog) <- makeLog- let alarmAction _ _ = do- writeLog "alarm going off"- threadDelay 200000- writeLog "alarm finished going off"+ it "goes off immediately if set to go off in the past" $ do+ (writeLog, readLog) <- makeLog+ withAlarmClock (\_ _ -> writeLog "alarm went off") $ \ac -> do+ startTime <- getCurrentTime+ now <- getAbsoluteTime+ setAlarm ac $ addTime (-0.1) now+ writeLog "alarm is set"+ waitUntilUnset ac+ writeLog "done"+ endTime <- getCurrentTime+ diffUTCTime endTime startTime `shouldSatisfy` (\t -> 0.0 <= t && t < 0.1)+ readLog `shouldReturn`+ [ "alarm is set"+ , "alarm went off"+ , "done"+ ] - withAlarmClock alarmAction $ \ac -> do- setAlarmNow (ac :: AlarmClock UTCTime)- threadDelay 100000- writeLog "destroying alarm clock"- writeLog "alarm clock destroyed"- readLog `shouldReturn`- [ "alarm going off"- , "destroying alarm clock"- , "alarm finished going off"- , "alarm clock destroyed"- ]+ it "blocks destruction if the alarm is going off" $ do+ (writeLog, readLog) <- makeLog+ let alarmAction _ _ = do+ writeLog "alarm going off"+ threadDelay 200000+ writeLog "alarm finished going off"++ withAlarmClock alarmAction $ \ac -> do+ setAlarmNow $ acid ac+ threadDelay 100000+ writeLog "destroying alarm clock"+ writeLog "alarm clock destroyed"+ readLog `shouldReturn`+ [ "alarm going off"+ , "destroying alarm clock"+ , "alarm finished going off"+ , "alarm clock destroyed"+ ]++ it "successfully destroys even if wakeup action tries to set again" $ do+ (writeLog, readLog) <- makeLog+ withAlarmClock (\ac t -> writeLog "alarm went off" >> setAlarm ac (addTime 0.2 t)) $ \ac -> do+ setAlarmNow $ acid ac+ threadDelay 100000+ threadDelay 300000+ readLog `shouldReturn` ["alarm went off"]++ it "picks the shorter time if a longer time is set in the wakeup" $ do+ (writeLog, readLog) <- makeLog+ withAlarmClock (\ac t -> writeLog "alarm went off" >> setAlarm ac (addTime 0.5 t)) $ \ac -> do+ setAlarmNow $ acid ac+ threadDelay 100000+ setAlarm ac . addTime 0.1 =<< getAbsoluteTime+ writeLog "set a shorter time"+ threadDelay 200000+ writeLog "alarm should have gone off after shorter time"+ threadDelay 500000+ writeLog "alarm should have gone off after longer time"+ readLog `shouldReturn`+ [ "alarm went off"+ , "set a shorter time"+ , "alarm went off"+ , "alarm should have gone off after shorter time"+ , "alarm went off"+ , "alarm should have gone off after longer time"+ ]++ it "doesn't block destruction even in a tight loop" $ withAlarmClock (\ac t -> setAlarm ac t) $ \ac -> do+ setAlarmNow $ acid ac+ threadDelay 100000++ describe "UTCTime" $ alarmClockSpec id $ addUTCTime . fromRational . toRational+ describe "MonotonicTime" $ alarmClockSpec id $ \dts (MonotonicTime ts) ->+ MonotonicTime $ fromNanoSecs $ toNanoSecs ts + floor (dts * 1e9) it "re-checks the time before going off" $ withAlarmClock (\_ _ -> return ()) $ \ac -> do