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 - psim...@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"
