diff --git a/alarmclock.cabal b/alarmclock.cabal
--- a/alarmclock.cabal
+++ b/alarmclock.cabal
@@ -1,5 +1,5 @@
 name:                alarmclock
-version:             0.2.0.6
+version:             0.2.0.7
 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
diff --git a/src/Control/Concurrent/AlarmClock.hs b/src/Control/Concurrent/AlarmClock.hs
--- a/src/Control/Concurrent/AlarmClock.hs
+++ b/src/Control/Concurrent/AlarmClock.hs
@@ -55,7 +55,18 @@
     -- so it can set a new alarm if desired. Note that `setAlarm` must be called once
     -- the alarm has gone off to cause it to go off again.
   -> IO AlarmClock
-newAlarmClock onWakeUp = do
+newAlarmClock onWakeUp = newAlarmClock' $ const . onWakeUp
+
+{-| 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. -}
+newAlarmClock'
+  :: (AlarmClock -> UTCTime -> IO ())
+    -- ^ Action to run when the alarm goes off. The action is provided the alarm clock
+    -- so it can set a new alarm if desired, and the current time.
+    -- Note that `setAlarm` must be called once the alarm has gone off to cause
+    -- it to go off again.
+  -> IO AlarmClock
+newAlarmClock' onWakeUp = do
   joinVar <- newEmptyMVar
   ac <- atomically $ AlarmClock (readMVar joinVar) <$> newTVar AlarmNotSet <*> newTVar False
   void $ forkIO $ runAlarmClock ac (onWakeUp ac) `finally` putMVar joinVar ()
@@ -99,7 +110,7 @@
 labelMyThread :: String -> IO ()
 labelMyThread threadLabel = myThreadId >>= flip labelThread threadLabel
 
-runAlarmClock :: AlarmClock -> IO () -> IO ()
+runAlarmClock :: AlarmClock -> (UTCTime -> IO ()) -> IO ()
 runAlarmClock AlarmClock{..} wakeUpAction = labelMyThread "alarmclock" >> loop
   where
   loop = readNextSetting >>= go
@@ -116,14 +127,18 @@
   go (Just wakeUpTime) = wakeNoLaterThan wakeUpTime
 
   wakeNoLaterThan wakeUpTime = do
-    dt <- ceiling <$> (1000000 *) <$> diffUTCTime wakeUpTime <$> getCurrentTime
-    if dt <= 0
-      then actAndContinue
-      else timeout dt readNextSetting >>= \case
-            Nothing -> actAndContinue
-            Just newSetting -> go newSetting
+    currentTime <- getCurrentTime
+    let dt = ceiling $ (1000000 *) $ diffUTCTime wakeUpTime currentTime
+    safeTimeout dt readNextSetting >>= \case
+      Nothing -> actAndContinue currentTime
+      Just newSetting -> go newSetting
 
-  actAndContinue = do
+  -- Times out immediately if the duration is negative (unlike 'timeout' which waits forever)
+  safeTimeout dt action
+    | dt > 0    = timeout dt action
+    | otherwise = return Nothing
+
+  actAndContinue currentTime = do
     atomically $ writeTVar acIsSet False
-    wakeUpAction
+    wakeUpAction currentTime
     loop