alarmclock 0.5.0.0 → 0.5.0.1

raw patch · 5 files changed

+214/−71 lines, 5 filesdep +alarmclockdep +hspecPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: alarmclock, hspec

API changes (from Hackage documentation)

Files

• alarmclock.cabal +49/−19
• src/Control/Concurrent/AlarmClock.hs +11/−52
• src/Control/Concurrent/AlarmClock/TimeScale.hs +51/−0
• test/Main.hs +60/−0
• test/Spec.hs +43/−0

@@ -1,26 +1,56 @@-name:                alarmclock-version:             0.5.0.0-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-license:             BSD3-license-file:        LICENSE-author:              David Turner-maintainer:          dave.c.turner@gmail.com-copyright:           (c) David Turner 2014-2018-category:            Concurrency-build-type:          Simple-cabal-version:       >=1.10+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: f32314cdbecd0b94d48ef50017c7c0a732da2ba508258c9709bc7614c5e3d173 +name:           alarmclock+version:        0.5.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+homepage:       https://bitbucket.org/davecturner/alarmclock+author:         David Turner+maintainer:     dave.c.turner@gmail.com+copyright:      2014-2018 David Turner+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10+ library-  exposed-modules:     Control.Concurrent.AlarmClock+  hs-source-dirs:+      src   build-depends:-      base >=4.8 && <4.12+      async+    , base >=4.8 && <4.12+    , clock     , stm-    , async     , time+    , unbounded-delays+  exposed-modules:+      Control.Concurrent.AlarmClock+      Control.Concurrent.AlarmClock.TimeScale+  other-modules:+      Paths_alarmclock+  default-language: Haskell2010++test-suite alarmclock-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      alarmclock+    , async+    , base >=4.8 && <4.12     , clock+    , hspec+    , stm+    , time     , unbounded-delays-  hs-source-dirs:      src-  default-language:    Haskell2010-  ghc-options: -Wall+  other-modules:+      Main+      Paths_alarmclock+  default-language: Haskell2010

@@ -35,59 +35,18 @@   , MonotonicTime(..)   ) where -import           Control.Concurrent.Async   (async, wait)-import           Control.Concurrent.STM     (STM, TVar, atomically, modifyTVar',-                                             newTVarIO, readTVar, retry,-                                             writeTVar)-import           Control.Concurrent.Timeout (timeout)-import           Control.Exception          (bracket)-import           Control.Monad.Fix          (mfix)-import           Data.Time                  (UTCTime, diffUTCTime,-                                             getCurrentTime)-import           GHC.Conc                   (labelThread, myThreadId)-import           System.Clock               (Clock (Monotonic), TimeSpec,-                                             diffTimeSpec, getTime,-                                             toNanoSecs)--{-| Abstraction that allows for a choice between the UTC timescale and a-monotonic timescale, which differ in their handling of irregularities such as-clock adjustments and leap seconds.--Alarms set using the 'UTCTime' timescale wait for the system clock to pass the-given time before going off, and account for the clock being adjusted-backwards and for (positive) leap seconds while waiting. If the clock is set-forwards, or a negative leap second occurs, then the alarm may go off later-than expected by an amount that is roughly equal to the adjustment. It is-possible to correct for this by setting the alarm again after the adjustment-has occurred.--The 'Monotonic' timescale cannot be so adjusted, which may be more suitable for-some applications.--Note that the timeliness of the alarm going off is very much on a "best effort"-basis, and there are many environmental factors that could cause the alarm to-go off later than expected.---}--class TimeScale t where-  getAbsoluteTime   :: IO t-  microsecondsDiff  :: t -> t -> Integer-  earlierOf         :: t -> t -> t--instance TimeScale UTCTime where-  getAbsoluteTime        = getCurrentTime-  earlierOf              = min-  microsecondsDiff t1 t2 = ceiling $ (1000000 *) $ diffUTCTime t1 t2--{-| Representation of system monotonic clock. -}-newtype MonotonicTime = MonotonicTime TimeSpec deriving (Show, Eq, Ord)+import           Control.Concurrent.Async                (async, wait)+import           Control.Concurrent.STM                  (STM, TVar, atomically,+                                                          modifyTVar',+                                                          newTVarIO, readTVar,+                                                          retry, writeTVar)+import           Control.Concurrent.Timeout              (timeout)+import           Control.Exception                       (bracket)+import           Control.Monad.Fix                       (mfix)+import           GHC.Conc                                (labelThread,+                                                          myThreadId) -instance TimeScale MonotonicTime where-  getAbsoluteTime = MonotonicTime <$> getTime Monotonic-  earlierOf       = min-  microsecondsDiff (MonotonicTime t1) (MonotonicTime t2)-                  = (`div` 1000) $ toNanoSecs $ diffTimeSpec t1 t2+import           Control.Concurrent.AlarmClock.TimeScale  {-| An 'AlarmClock' is a device for running an action at (or shortly after) a certain time. -} data AlarmClock t = AlarmClock

@@ -0,0 +1,51 @@++{-| Abstraction that allows for a choice of timescale when setting alarms.+Exposed in a separate module so it can be faked for testing purposes, but+client applications should just import "Control.Concurrent.AlarmClock". -}++module Control.Concurrent.AlarmClock.TimeScale where++import           Data.Time    (UTCTime, diffUTCTime, getCurrentTime)+import           System.Clock (Clock (Monotonic), TimeSpec, diffTimeSpec,+                               getTime, toNanoSecs)++{-| Abstraction that allows for a choice between the UTC timescale and a+monotonic timescale, which differ in their handling of irregularities such as+clock adjustments and leap seconds.++Alarms set using the 'UTCTime' timescale wait for the system clock to pass the+given time before going off, and account for the clock being adjusted+backwards and for (positive) leap seconds while waiting. If the clock is set+forwards, or a negative leap second occurs, then the alarm may go off later+than expected by an amount that is roughly equal to the adjustment. It is+possible to correct for this by setting the alarm again after the adjustment+has occurred.++The 'Monotonic' timescale cannot be so adjusted, which may be more suitable for+some applications.++Note that the timeliness of the alarm going off is very much on a "best effort"+basis, and there are many environmental factors that could cause the alarm to+go off later than expected.++-}++class TimeScale t where+  getAbsoluteTime   :: IO t+  microsecondsDiff  :: t -> t -> Integer+  earlierOf         :: t -> t -> t++instance TimeScale UTCTime where+  getAbsoluteTime        = getCurrentTime+  earlierOf              = min+  microsecondsDiff t1 t2 = ceiling $ (1000000 *) $ diffUTCTime t1 t2++{-| Representation of system monotonic clock. -}+newtype MonotonicTime = MonotonicTime TimeSpec deriving (Show, Eq, Ord)++instance TimeScale MonotonicTime where+  getAbsoluteTime = MonotonicTime <$> getTime Monotonic+  earlierOf       = min+  microsecondsDiff (MonotonicTime t1) (MonotonicTime t2)+    | t1 < t2 = -microsecondsDiff (MonotonicTime t2) (MonotonicTime t1)+    | otherwise = (`div` 1000) $ toNanoSecs $ diffTimeSpec t1 t2

@@ -0,0 +1,60 @@+{-# 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"

@@ -0,0 +1,43 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import           Test.Hspec++import           Control.Concurrent+import           Control.Concurrent.AlarmClock.TimeScale+import           Data.Proxy+import           Data.Time++main :: IO ()+main = hspec $ describe "Control.Concurrent.AlarmClock" $ do++  describe "Timescale" $ do+    let beforeTimescaleTest :: TimeScale t => IO (t,t)+        beforeTimescaleTest = do+          putStrLn "getting first time"+          t0 <- getAbsoluteTime+          threadDelay 500000+          putStrLn "getting second time"+          t1 <- getAbsoluteTime+          putStrLn "got times"+          return (t0, t1)++        timescaleSpec :: (TimeScale t, Eq t, Show t) => Proxy t -> SpecWith (t,t)+        timescaleSpec _ = do+          describe "earlierOf" $ do+            it "picks the first if earlier"  $ \(t0,t1) -> earlierOf t0 t1 `shouldBe` t0+            it "picks the second if earlier" $ \(t0,t1) -> earlierOf t1 t0 `shouldBe` t0++          describe "microsecondsDiff" $ do+            it "finds a difference of at least 500ms"+              $ \(t0,t1) -> microsecondsDiff t1 t0 `shouldSatisfy` (>= 500000)+            it "finds a difference of no more than 600ms"+              $ \(t0,t1) -> microsecondsDiff t1 t0 `shouldSatisfy` (<= 600000)+            it "finds a negative difference if args reversed"+              $ \(t0,t1) -> microsecondsDiff t0 t1 `shouldSatisfy` (<= (-500000))++    describe "UTCTime"   $ beforeAll beforeTimescaleTest $ timescaleSpec (Proxy :: Proxy UTCTime)+    describe "Monotonic" $ beforeAll beforeTimescaleTest $ timescaleSpec (Proxy :: Proxy MonotonicTime)++  return ()