Hello community, here is the log from the commit of package ghc-alarmclock for openSUSE:Factory checked in at 2016-10-19 13:02:53 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-alarmclock (Old) and /work/SRC/openSUSE:Factory/.ghc-alarmclock.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-alarmclock" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-alarmclock/ghc-alarmclock.changes 2016-09-25 14:31:34.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-alarmclock.new/ghc-alarmclock.changes 2016-10-19 13:02:55.000000000 +0200 @@ -1,0 +2,5 @@ +Thu Sep 15 06:38:45 UTC 2016 - psimons@suse.com + +- Update to version 0.4.0.2 revision 0 with cabal2obs. + +------------------------------------------------------------------- Old: ---- alarmclock-0.2.0.9.tar.gz New: ---- alarmclock-0.4.0.2.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-alarmclock.spec ++++++ --- /var/tmp/diff_new_pack.x0bwuv/_old 2016-10-19 13:02:56.000000000 +0200 +++ /var/tmp/diff_new_pack.x0bwuv/_new 2016-10-19 13:02:56.000000000 +0200 @@ -18,22 +18,21 @@ %global pkg_name alarmclock Name: ghc-%{pkg_name} -Version: 0.2.0.9 +Version: 0.4.0.2 Release: 0 Summary: Wake up and perform an action at a certain time License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz -# Begin cabal-rpm deps: -BuildRequires: chrpath BuildRequires: ghc-Cabal-devel +BuildRequires: ghc-async-devel +BuildRequires: ghc-clock-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-stm-devel BuildRequires: ghc-time-devel BuildRequires: ghc-unbounded-delays-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build -# End cabal-rpm deps %description Wake up and perform an action at a certain time. @@ -52,15 +51,11 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install -rm %{buildroot}/%{_bindir}/test - %post devel %ghc_pkg_recache ++++++ alarmclock-0.2.0.9.tar.gz -> alarmclock-0.4.0.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/alarmclock-0.2.0.9/alarmclock.cabal new/alarmclock-0.4.0.2/alarmclock.cabal --- old/alarmclock-0.2.0.9/alarmclock.cabal 2016-03-31 13:30:27.000000000 +0200 +++ new/alarmclock-0.4.0.2/alarmclock.cabal 2016-07-05 12:06:07.000000000 +0200 @@ -1,5 +1,5 @@ name: alarmclock -version: 0.2.0.9 +version: 0.4.0.2 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 @@ -15,18 +15,12 @@ library exposed-modules: Control.Concurrent.AlarmClock build-depends: - base >=4.7 && <4.9 + base >=4.8 && <4.10 , stm + , async , time + , clock , unbounded-delays hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall - -executable test - main-is: Main.hs - hs-source-dirs: test - default-language: Haskell2010 - build-depends: base - , alarmclock - , time diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/alarmclock-0.2.0.9/src/Control/Concurrent/AlarmClock.hs new/alarmclock-0.4.0.2/src/Control/Concurrent/AlarmClock.hs --- old/alarmclock-0.2.0.9/src/Control/Concurrent/AlarmClock.hs 2016-03-31 13:29:53.000000000 +0200 +++ new/alarmclock-0.4.0.2/src/Control/Concurrent/AlarmClock.hs 2016-07-05 12:04:55.000000000 +0200 @@ -1,4 +1,4 @@ -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-| Device for running an action at (i.e. shortly after) a certain time, which @@ -31,93 +31,121 @@ , setAlarmNow , isAlarmSet , isAlarmSetSTM + , TimeScale(..) + , MonotonicTime(..) ) where -import Control.Applicative ((<$>), (<*>)) -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, bracket) -import Control.Monad (void) -import Data.Time (UTCTime, diffUTCTime, getCurrentTime) -import GHC.Conc (labelThread, myThreadId) +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, + timeSpecAsNanoSecs) + +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) + = (`div` 1000) $ timeSpecAsNanoSecs $ diffTimeSpec t1 t2 {-| An 'AlarmClock' is a device for running an action at (or shortly after) a certain time. -} -data AlarmClock = AlarmClock +data AlarmClock t = AlarmClock { acWaitForExit :: IO () - , acNewSetting :: TVar AlarmSetting + , acNewSetting :: TVar (AlarmSetting t) , 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. -} newAlarmClock - :: (AlarmClock -> IO ()) + :: TimeScale t + => (AlarmClock t -> 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. Note that `setAlarm` must be called once -- the alarm has gone off to cause it to go off again. - -> IO AlarmClock + -> IO (AlarmClock t) 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 ()) + :: TimeScale t + => (AlarmClock t -> t -> 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 () - return ac + -> IO (AlarmClock t) +newAlarmClock' onWakeUp = mfix $ \ac -> do + acAsync <- async $ runAlarmClock ac (onWakeUp ac) + AlarmClock (wait acAsync) <$> newTVarIO AlarmNotSet <*> newTVarIO False {-| 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 t -> IO () destroyAlarmClock AlarmClock{..} = atomically (writeTVar acNewSetting AlarmDestroyed) >> acWaitForExit {-| The action @withAlarmClock onWakeUp inner@ runs @inner@ with a new 'AlarmClock' which is destroyed when @inner@ exits. -} -withAlarmClock :: (AlarmClock -> UTCTime -> IO ()) -> (AlarmClock -> IO a) -> IO a +withAlarmClock :: TimeScale t + => (AlarmClock t -> t -> IO ()) + -> (AlarmClock t -> IO a) -> IO a withAlarmClock onWakeUp inner = bracket (newAlarmClock' onWakeUp) destroyAlarmClock inner {-| 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 :: TimeScale t => AlarmClock t -> t -> IO () 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 :: TimeScale t => AlarmClock t -> t -> STM () setAlarmSTM AlarmClock{..} t = modifyTVar' acNewSetting $ \case AlarmDestroyed -> AlarmDestroyed AlarmNotSet -> AlarmSet t - AlarmSet t' -> AlarmSet $! min t t' + AlarmSet t' -> AlarmSet $! earlierOf t t' {-| Make the 'AlarmClock' go off right now. -} -setAlarmNow :: AlarmClock -> IO () -setAlarmNow alarm = getCurrentTime >>= setAlarm alarm +setAlarmNow :: TimeScale t => AlarmClock t -> IO () +setAlarmNow alarm = getAbsoluteTime >>= 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 :: AlarmClock t -> 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 t -> STM Bool isAlarmSetSTM AlarmClock{..} = readTVar acNewSetting
= \case { AlarmNotSet -> readTVar acIsSet; _ -> return True }
-data AlarmSetting = AlarmNotSet | AlarmSet UTCTime | AlarmDestroyed +data AlarmSetting t = AlarmNotSet | AlarmSet t | AlarmDestroyed labelMyThread :: String -> IO () labelMyThread threadLabel = myThreadId >>= flip labelThread threadLabel -runAlarmClock :: AlarmClock -> (UTCTime -> IO ()) -> IO () +runAlarmClock :: TimeScale t => AlarmClock t -> (t -> IO ()) -> IO () runAlarmClock AlarmClock{..} wakeUpAction = labelMyThread "alarmclock" >> loop where loop = readNextSetting >>= go @@ -134,9 +162,8 @@ go (Just wakeUpTime) = wakeNoLaterThan wakeUpTime wakeNoLaterThan wakeUpTime = do - currentTime <- getCurrentTime - let dt = ceiling $ (1000000 *) $ diffUTCTime wakeUpTime currentTime - safeTimeout dt readNextSetting >>= \case + timeoutLength <- microsecondsDiff wakeUpTime <$> getAbsoluteTime + safeTimeout timeoutLength readNextSetting >>= \case Nothing -> actAndContinue Just newSetting -> go newSetting @@ -147,5 +174,5 @@ actAndContinue = do atomically $ writeTVar acIsSet False - wakeUpAction =<< getCurrentTime + wakeUpAction =<< getAbsoluteTime loop diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/alarmclock-0.2.0.9/test/Main.hs new/alarmclock-0.4.0.2/test/Main.hs --- old/alarmclock-0.2.0.9/test/Main.hs 2015-09-17 10:36:02.000000000 +0200 +++ new/alarmclock-0.4.0.2/test/Main.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,61 +0,0 @@ -{-# LANGUAGE LambdaCase #-} - -module Main (main) where - -import Control.Applicative -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 -> 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 -> IO () -setAlarmLog ac t = do - printWithTime $ printf "alarm set for %s" $ show t - setAlarm ac t - -setAlarmNowLog :: AlarmClock -> 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"