alarmclock 0.2.0.4 → 0.2.0.5

raw patch · 2 files changed

+23/−25 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 +22/−24

@@ -1,5 +1,5 @@ name:                alarmclock-version:             0.2.0.4+version:             0.2.0.5 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

@@ -32,12 +32,13 @@   ) where  import Control.Applicative ((<$>), (<*>))-import Control.Concurrent (forkIO)+import Control.Concurrent (forkIO, newEmptyMVar, readMVar, putMVar) import Control.Concurrent.STM (STM, atomically, retry, TVar, newTVar, writeTVar, readTVar, modifyTVar') import Control.Concurrent.Timeout (timeout) import Control.Exception (finally) import Control.Monad (void) import Data.Time (UTCTime, diffUTCTime, getCurrentTime)+import GHC.Conc (labelThread, myThreadId)  {-| An 'AlarmClock' is a device for running an action at (or shortly after) a certain time. -} data AlarmClock = AlarmClock@@ -55,14 +56,11 @@     -- the alarm has gone off to cause it to go off again.   -> IO AlarmClock newAlarmClock onWakeUp = do-  joinVar <- atomically $ newTVar False-  ac <- atomically $ AlarmClock (waitOn joinVar) <$> newTVar AlarmNotSet <*> newTVar False-  void $ forkIO $ runAlarmClock ac (onWakeUp ac) `finally` atomically (writeTVar joinVar True)+  joinVar <- newEmptyMVar+  ac <- atomically $ AlarmClock (readMVar joinVar) <$> newTVar AlarmNotSet <*> newTVar False+  void $ forkIO $ runAlarmClock ac (onWakeUp ac) `finally` putMVar joinVar ()   return ac -waitOn :: TVar Bool -> IO ()-waitOn v = atomically $ readTVar v >>= \case True -> return (); False -> retry- {-| 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. -} destroyAlarmClock :: AlarmClock -> IO ()@@ -98,34 +96,34 @@  data AlarmSetting = AlarmNotSet | AlarmSet UTCTime | AlarmDestroyed -readNextAlarmSetting :: AlarmClock -> IO (Maybe UTCTime)-readNextAlarmSetting AlarmClock{..} = atomically $ readTVar acNewSetting >>= \case-  AlarmNotSet    -> retry-  AlarmDestroyed -> return Nothing-  AlarmSet t     -> do-    writeTVar acNewSetting AlarmNotSet-    writeTVar acIsSet True-    return $ Just t+labelMyThread :: String -> IO ()+labelMyThread threadLabel = myThreadId >>= flip labelThread threadLabel  runAlarmClock :: AlarmClock -> IO () -> IO ()-runAlarmClock ac wakeUpAction = loop+runAlarmClock AlarmClock{..} wakeUpAction = labelMyThread "alarmclock" >> loop   where-  loop = readNextAlarmSetting ac >>= go+  loop = readNextSetting >>= go +  readNextSetting = atomically $ readTVar acNewSetting >>= \case+    AlarmNotSet    -> retry+    AlarmDestroyed -> return Nothing+    AlarmSet t     -> do+      writeTVar acNewSetting AlarmNotSet+      writeTVar acIsSet True+      return $ Just t+   go Nothing           = return ()   go (Just wakeUpTime) = wakeNoLaterThan wakeUpTime    wakeNoLaterThan wakeUpTime = do-    dt <- diffUTCTime wakeUpTime <$> getCurrentTime+    dt <- ceiling <$> (1000000 *) <$> diffUTCTime wakeUpTime <$> getCurrentTime     if dt <= 0       then actAndContinue-      else timeout (ceiling $ 1000000 * dt)-                   (readNextAlarmSetting ac)-            >>= \case-              Nothing -> actAndContinue-              Just newSetting -> go newSetting+      else timeout dt readNextSetting >>= \case+            Nothing -> actAndContinue+            Just newSetting -> go newSetting    actAndContinue = do-    atomically $ writeTVar (acIsSet ac) False+    atomically $ writeTVar acIsSet False     wakeUpAction     loop