alarmclock 0.5.0.2 → 0.6.0.1

raw patch · 5 files changed

+45/−35 lines, 5 filessetup-changedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Setup.hs +1/−1
• alarmclock.cabal +5/−4
• src/Control/Concurrent/AlarmClock.hs +30/−25
• src/Control/Concurrent/AlarmClock/TimeScale.hs +1/−1
• test/Spec.hs +8/−4

@@ -1,2 +1,2 @@-import Distribution.Simple+import           Distribution.Simple main = defaultMain

@@ -1,11 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.20.0.+-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack ----- hash: 8d07c55bfbba37064e7a34b1ddfaeb436a9c8a9c2335f1bb78be9cb1827d6d37+-- hash: 3d079241564ac100016ed2bad6050d1543f11df47698f2a6035f587e0db961b0  name:           alarmclock-version:        0.5.0.2+version:        0.6.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@@ -21,6 +21,7 @@ library   hs-source-dirs:       src+  ghc-options: -Wall   build-depends:       async     , base >=4.8 && <4.12@@ -40,7 +41,7 @@   main-is: Spec.hs   hs-source-dirs:       test-  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N   build-depends:       alarmclock     , async

@@ -35,24 +35,28 @@   , MonotonicTime(..)   ) where -import           Control.Concurrent.Async                (async, wait)+import           Control.Concurrent.Async                (async, wait, waitSTM,+                                                          withAsync) import           Control.Concurrent.STM                  (STM, TVar, atomically,                                                           modifyTVar',-                                                          newTVarIO, readTVar,-                                                          retry, writeTVar)-import           Control.Concurrent.Timeout              (timeout)+                                                          newTVarIO, orElse,+                                                          readTVar, retry,+                                                          writeTVar)+import           Control.Concurrent.Thread.Delay         (delay) import           Control.Exception                       (bracket) import           Control.Monad.Fix                       (mfix) import           GHC.Conc                                (labelThread,                                                           myThreadId)+import Control.Monad (join)  import           Control.Concurrent.AlarmClock.TimeScale +data AlarmSetting t = AlarmNotSet | AlarmSet t | AlarmDestroyed+ {-| An 'AlarmClock' is a device for running an action at (or shortly after) a certain time. -} data AlarmClock t = AlarmClock   { acWaitForExit :: IO ()   , acNewSetting  :: TVar (AlarmSetting t)-  , acIsSet       :: TVar Bool   }  {-| Create a new 'AlarmClock' that runs the given action. Initially, there is@@ -78,7 +82,7 @@   -> IO (AlarmClock t) newAlarmClock' onWakeUp = mfix $ \ac -> do   acAsync <- async $ runAlarmClock ac (onWakeUp ac)-  AlarmClock (wait acAsync) <$> newTVarIO AlarmNotSet <*> newTVarIO False+  AlarmClock (wait acAsync) <$> newTVarIO AlarmNotSet  {-| Destroy the 'AlarmClock' so no further alarms will occur. If the alarm is currently going off then this will block until the action is finished. -}@@ -103,9 +107,9 @@ earliest given time. -} setAlarmSTM :: TimeScale t => AlarmClock t -> t -> STM () setAlarmSTM AlarmClock{..} t = modifyTVar' acNewSetting $ \case-  AlarmDestroyed -> AlarmDestroyed   AlarmNotSet    -> AlarmSet t   AlarmSet t'    -> AlarmSet $! earlierOf t t'+  AlarmDestroyed -> AlarmDestroyed  {-| Make the 'AlarmClock' go off right now. -} setAlarmNow :: TimeScale t => AlarmClock t -> IO ()@@ -118,9 +122,7 @@ {-| Is the alarm set - i.e. will it go off at some point in the future even if `setAlarm` is not called? -} isAlarmSetSTM :: AlarmClock t -> STM Bool isAlarmSetSTM AlarmClock{..} = readTVar acNewSetting-  >>= \case { AlarmNotSet -> readTVar acIsSet; _ -> return True }--data AlarmSetting t = AlarmNotSet | AlarmSet t | AlarmDestroyed+  >>= \case { AlarmSet _ -> return True; _ -> return False }  labelMyThread :: String -> IO () labelMyThread threadLabel = myThreadId >>= flip labelThread threadLabel@@ -128,26 +130,29 @@ runAlarmClock :: TimeScale t => AlarmClock t -> (t -> IO ()) -> IO () runAlarmClock AlarmClock{..} wakeUpAction = labelMyThread "alarmclock" >> loop   where-  loop = readNextSetting >>= handleNewSetting--  readNextSetting = atomically $ readTVar acNewSetting >>= \case-    AlarmNotSet    -> retry-    AlarmDestroyed -> return Nothing-    AlarmSet t     -> do-      writeTVar acNewSetting AlarmNotSet-      writeTVar acIsSet True-      return $ Just t+  loop :: IO ()+  loop = join $ atomically whenNotSet -  handleNewSetting Nothing           = return ()-  handleNewSetting (Just wakeUpTime) = wakeShortlyAfter wakeUpTime+  whenNotSet :: STM (IO ())+  whenNotSet = readTVar acNewSetting >>= \case+    AlarmNotSet         -> retry+    AlarmDestroyed      -> return $ return ()+    AlarmSet wakeUpTime -> return $ whenSet wakeUpTime -  wakeShortlyAfter wakeUpTime = do+  whenSet wakeUpTime = do     now <- getAbsoluteTime     let microsecondsTimeout = microsecondsDiff wakeUpTime now     if 0 < microsecondsTimeout-      then maybe (wakeShortlyAfter wakeUpTime) handleNewSetting-              =<< timeout microsecondsTimeout readNextSetting+      then join $ withAsync (delay microsecondsTimeout) $ \a -> atomically $+                      waitSTM a >> return (whenSet wakeUpTime)+                    `orElse`+                      (readTVar acNewSetting >>= \case+                          AlarmSet wakeUpTime' | earlierOf wakeUpTime' wakeUpTime /= wakeUpTime -> return $ whenSet wakeUpTime'+                          AlarmDestroyed                                                        -> return $ return ()+                          _                                                                     -> retry+                      )+       else do-        atomically $ writeTVar acIsSet False+        atomically $ writeTVar acNewSetting AlarmNotSet         wakeUpAction now         loop

@@ -30,7 +30,7 @@  -} -class TimeScale t where+class Eq t => TimeScale t where   getAbsoluteTime   :: IO t   microsecondsDiff  :: t -> t -> Integer   earlierOf         :: t -> t -> t

@@ -50,6 +50,10 @@         return (modifyIORef logVar . (:), reverse <$> readIORef logVar)    describe "AlarmClock" $ do+    let waitUntilUnset ac = do+          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@@ -126,7 +130,7 @@           setAlarmSTM ac $ addUTCTime 0.1 now           guard =<< isAlarmSetSTM ac         writeLog "alarm is set"-        atomically $ guard . not =<< isAlarmSetSTM ac+        waitUntilUnset ac         writeLog "alarm now not set again"       readLog `shouldReturn`         [ "alarm is set"@@ -140,11 +144,11 @@         startTime <- getCurrentTime         setAlarm ac $ addUTCTime 0.1 startTime         writeLog "alarm is set"-        atomically $ guard . not =<< isAlarmSetSTM ac+        waitUntilUnset ac         writeLog "alarm is not set"         setAlarm ac $ addUTCTime 0.2 startTime         writeLog "alarm is set"-        atomically $ guard . not =<< isAlarmSetSTM ac+        waitUntilUnset ac         writeLog "alarm is not set"       readLog `shouldReturn`         [ "alarm is set"@@ -161,7 +165,7 @@         startTime <- getCurrentTime         setAlarm ac $ addUTCTime (-0.1) startTime         writeLog "alarm is set"-        atomically $ guard . not =<< isAlarmSetSTM ac+        waitUntilUnset ac         writeLog "done"         endTime <- getCurrentTime         diffUTCTime endTime startTime `shouldSatisfy` (\t -> 0.0 <= t && t < 0.1)