alarmclock 0.5.0.1 → 0.5.0.2
raw patch · 3 files changed
+166/−64 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- alarmclock.cabal +2/−3
- test/Main.hs +0/−60
- test/Spec.hs +164/−1
alarmclock.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: f32314cdbecd0b94d48ef50017c7c0a732da2ba508258c9709bc7614c5e3d173+-- hash: 8d07c55bfbba37064e7a34b1ddfaeb436a9c8a9c2335f1bb78be9cb1827d6d37 name: alarmclock-version: 0.5.0.1+version: 0.5.0.2 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@@ -51,6 +51,5 @@ , time , unbounded-delays other-modules:- Main Paths_alarmclock default-language: Haskell2010
− test/Main.hs
@@ -1,60 +0,0 @@-{-# LANGUAGE LambdaCase #-}--module Main (main) where--import Control.Concurrent-import Control.Concurrent.AlarmClock-import Control.Exception-import Data.IORef-import Data.Time-import Text.Printf--printWithTime :: String -> IO ()-printWithTime s = do- t <- getCurrentTime- putStrLn $ printf "%-32s: %s" (show t) s--alarmAction :: IORef Bool -> AlarmClock UTCTime -> IO ()-alarmAction v ac = do- printWithTime "alarm went off"- threadDelay 3000000- readIORef v >>= \case- False -> return ()- True -> do- t <- addUTCTime 5 <$> getCurrentTime- setAlarmLog ac t- threadDelay 3000000- printWithTime "alarm action finished"--setAlarmLog :: AlarmClock UTCTime -> UTCTime -> IO ()-setAlarmLog ac t = do- printWithTime $ printf "alarm set for %s" $ show t- setAlarm ac t--setAlarmNowLog :: AlarmClock UTCTime -> IO ()-setAlarmNowLog ac = do- printWithTime "alarm set for now"- setAlarmNow ac--main :: IO ()-main = do- v <- newIORef True- bracket (newAlarmClock $ alarmAction v) destroyAlarmClock $ \ac -> do- t <- getCurrentTime- mask $ \_ -> do- setAlarmLog ac $ addUTCTime 2 t- setAlarmLog ac $ addUTCTime (pred 2) t- setAlarmLog ac $ addUTCTime (succ 2) t- threadDelay 500000- setAlarmLog ac $ addUTCTime 4 t- threadDelay 1900000- setAlarmNowLog ac- threadDelay 8000000- printWithTime "cancelling alarm repeat"- writeIORef v False- threadDelay 7000000- setAlarmLog ac $ addUTCTime 1 t- threadDelay 500000- setAlarmLog ac $ addUTCTime 20 t- threadDelay 4000000- printWithTime "done"
test/Spec.hs view
@@ -5,7 +5,11 @@ import Test.Hspec import Control.Concurrent+import Control.Concurrent.AlarmClock import Control.Concurrent.AlarmClock.TimeScale+import Control.Concurrent.STM+import Control.Monad+import Data.IORef import Data.Proxy import Data.Time @@ -40,4 +44,163 @@ describe "UTCTime" $ beforeAll beforeTimescaleTest $ timescaleSpec (Proxy :: Proxy UTCTime) describe "Monotonic" $ beforeAll beforeTimescaleTest $ timescaleSpec (Proxy :: Proxy MonotonicTime) - return ()+ let makeLog :: IO (a -> IO (), IO [a])+ makeLog = do+ logVar <- newIORef []+ return (modifyIORef logVar . (:), reverse <$> readIORef logVar)++ describe "AlarmClock" $ do+ 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"]++ 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 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 "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 "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"+ atomically $ guard . not =<< isAlarmSetSTM ac+ writeLog "alarm now not set again"+ readLog `shouldReturn`+ [ "alarm is set"+ , "alarm went off"+ , "alarm now not set again"+ ]++ 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"+ atomically $ guard . not =<< isAlarmSetSTM ac+ writeLog "alarm is not set"+ setAlarm ac $ addUTCTime 0.2 startTime+ writeLog "alarm is set"+ atomically $ guard . not =<< isAlarmSetSTM 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 "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"+ atomically $ guard . not =<< isAlarmSetSTM 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 "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 (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 "re-checks the time before going off" $+ withAlarmClock (\_ _ -> return ()) $ \ac -> do+ startTime <- getCurrentTime+ setAlarm ac $ AdjustingClock $ addUTCTime 0.3 startTime+ atomically $ guard . not =<< isAlarmSetSTM ac+ endTime <- getCurrentTime+ diffUTCTime endTime startTime `shouldSatisfy` (\t -> 0.3 <= t && t <= 0.5)++newtype AdjustingClock = AdjustingClock UTCTime deriving (Show, Eq, Ord)++instance TimeScale AdjustingClock where+ getAbsoluteTime = AdjustingClock <$> getCurrentTime+ earlierOf = min+ microsecondsDiff (AdjustingClock t1) (AdjustingClock t2) = 10000 + microsecondsDiff t1 t2 `div` 2