alarmclock 0.2.0.2 → 0.2.0.3

raw patch · 2 files changed

+39/−10 lines, 2 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• alarmclock.cabal +1/−1
• src/Control/Concurrent/AlarmClock.hs +38/−9

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

@@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}  {-| Device for running an action at (i.e. shortly after) a certain time, which can be used to implement things like time-based cache expiry.@@ -24,7 +25,10 @@   , newAlarmClock   , destroyAlarmClock   , setAlarm+  , setAlarmSTM   , setAlarmNow+  , isAlarmSet+  , isAlarmSetSTM   ) where  import Control.Applicative@@ -36,7 +40,11 @@ import System.Timeout  {-| An 'AlarmClock' is a device for running an action at (or shortly after) a certain time. -}-data AlarmClock = AlarmClock (IO ()) (TVar AlarmSetting)+data AlarmClock = AlarmClock+  { acWaitForExit :: IO ()+  , acNewSetting  :: TVar AlarmSetting+  , acIsSet       :: TVar Bool+  }  {-| 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. -}@@ -48,7 +56,7 @@   -> IO AlarmClock newAlarmClock onWakeUp = do   joinVar <- atomically $ newTVar False-  ac <- atomically $ AlarmClock (waitOn joinVar) <$> newTVar AlarmNotSet+  ac <- atomically $ AlarmClock (waitOn joinVar) <$> newTVar AlarmNotSet <*> newTVar False   void $ forkIO $ runAlarmClock ac (onWakeUp ac) `finally` atomically (writeTVar joinVar True)   return ac @@ -58,28 +66,46 @@ {-| 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 ()-destroyAlarmClock (AlarmClock j q) = atomically (writeTVar q AlarmDestroyed) >> j+destroyAlarmClock AlarmClock{..} = atomically (writeTVar acNewSetting AlarmDestroyed) >> acWaitForExit  {-| Make the 'AlarmClock' go off at (or shortly after) the given time.  This can be called more than once; in which case, the alarm will go off at the earliest given time. -} setAlarm :: AlarmClock -> UTCTime -> IO ()-setAlarm (AlarmClock _ q) t = atomically $ modifyTVar' q $ \case+setAlarm ac t = atomically $ setAlarmSTM ac t++{-| Make the 'AlarmClock' go off at (or shortly after) the given time.  This+can be called more than once; in which case, the alarm will go off at the+earliest given time. -}+setAlarmSTM :: AlarmClock -> UTCTime -> STM ()+setAlarmSTM AlarmClock{..} t = modifyTVar' acNewSetting $ \case   AlarmDestroyed -> AlarmDestroyed-  AlarmNotSet -> AlarmSet t-  AlarmSet t' -> AlarmSet $! min t t'+  AlarmNotSet    -> AlarmSet t+  AlarmSet t'    -> AlarmSet $! min t t'  {-| Make the 'AlarmClock' go off right now. -} setAlarmNow :: AlarmClock -> IO () setAlarmNow alarm = getCurrentTime >>= setAlarm alarm +{-| Is the alarm set - i.e. will it go off at some point in the future even if `setAlarm` is not called? -}+isAlarmSet :: AlarmClock -> IO Bool+isAlarmSet = atomically . isAlarmSetSTM++{-| Is the alarm set - i.e. will it go off at some point in the future even if `setAlarm` is not called? -}+isAlarmSetSTM :: AlarmClock -> STM Bool+isAlarmSetSTM AlarmClock{..} = readTVar acNewSetting+  >>= \case { AlarmNotSet -> readTVar acIsSet; _ -> return True }+ data AlarmSetting = AlarmNotSet | AlarmSet UTCTime | AlarmDestroyed  readNextAlarmSetting :: AlarmClock -> IO (Maybe UTCTime)-readNextAlarmSetting (AlarmClock _ q) = atomically $ readTVar q >>= \case+readNextAlarmSetting AlarmClock{..} = atomically $ readTVar acNewSetting >>= \case   AlarmNotSet    -> retry   AlarmDestroyed -> return Nothing-  AlarmSet t     -> writeTVar q AlarmNotSet >> return (Just t)+  AlarmSet t     -> do+    writeTVar acNewSetting AlarmNotSet+    writeTVar acIsSet True+    return $ Just t  runAlarmClock :: AlarmClock -> IO () -> IO () runAlarmClock ac wakeUpAction = loop@@ -103,7 +129,10 @@                   else actAndContinue               Just newSetting -> go newSetting -  actAndContinue = wakeUpAction >> loop+  actAndContinue = do+    atomically $ writeTVar (acIsSet ac) False+    wakeUpAction+    loop  maxDelay :: Integer maxDelay = fromIntegral (maxBound :: Int)