Hello community, here is the log from the commit of package ghc-auto-update for openSUSE:Factory checked in at 2016-01-07 00:25:16 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-auto-update (Old) and /work/SRC/openSUSE:Factory/.ghc-auto-update.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-auto-update" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-auto-update/ghc-auto-update.changes 2015-08-07 00:25:19.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-auto-update.new/ghc-auto-update.changes 2016-01-07 00:25:28.000000000 +0100 @@ -1,0 +2,6 @@ +Thu Dec 17 10:26:54 UTC 2015 - mimi.vx@gmail.com + +- update to 0.1.3 +* Adding a new AIP - reaperKill + +------------------------------------------------------------------- Old: ---- auto-update-0.1.2.2.tar.gz New: ---- auto-update-0.1.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-auto-update.spec ++++++ --- /var/tmp/diff_new_pack.QHFNJO/_old 2016-01-07 00:25:30.000000000 +0100 +++ /var/tmp/diff_new_pack.QHFNJO/_new 2016-01-07 00:25:30.000000000 +0100 @@ -19,7 +19,7 @@ %global pkg_name auto-update Name: ghc-auto-update -Version: 0.1.2.2 +Version: 0.1.3 Release: 0 Summary: Efficiently run periodic, on-demand actions License: MIT ++++++ auto-update-0.1.2.2.tar.gz -> auto-update-0.1.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/auto-update-0.1.2.2/ChangeLog.md new/auto-update-0.1.3/ChangeLog.md --- old/auto-update-0.1.2.2/ChangeLog.md 2015-07-05 07:04:58.000000000 +0200 +++ new/auto-update-0.1.3/ChangeLog.md 2015-12-16 07:13:54.000000000 +0100 @@ -1 +1,2 @@ +__0.1.3__ Adding a new AIP - reaperKill __0.1.2__ Added Control.Debounce diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/auto-update-0.1.2.2/Control/Reaper.hs new/auto-update-0.1.3/Control/Reaper.hs --- old/auto-update-0.1.2.2/Control/Reaper.hs 2015-07-05 07:04:58.000000000 +0200 +++ new/auto-update-0.1.3/Control/Reaper.hs 2015-12-16 07:13:54.000000000 +0100 @@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE BangPatterns #-} -- | This module provides the ability to create reapers: dedicated cleanup -- threads. These threads will automatically spawn and die based on the @@ -22,10 +23,9 @@ ) where import Control.AutoUpdate.Util (atomicModifyIORef') -import Control.Concurrent (forkIO, threadDelay) +import Control.Concurrent (forkIO, threadDelay, killThread, ThreadId) import Control.Exception (mask_) -import Control.Monad (join, void) -import Data.IORef (IORef, newIORef, readIORef) +import Data.IORef (IORef, newIORef, readIORef, writeIORef) -- | Settings for creating a reaper. This type has two parameters: -- @workload@ gives the entire workload, whereas @item@ gives an @@ -96,6 +96,8 @@ -- | Stopping the reaper thread if exists. -- The current workload is returned. , reaperStop :: IO workload + -- | Killing the reaper thread immediately if exists. + , reaperKill :: IO () } -- | State of reaper. @@ -110,10 +112,12 @@ mkReaper :: ReaperSettings workload item -> IO (Reaper workload item) mkReaper settings@ReaperSettings{..} = do stateRef <- newIORef NoReaper + tidRef <- newIORef Nothing return Reaper { - reaperAdd = update settings stateRef + reaperAdd = add settings stateRef tidRef , reaperRead = readRef stateRef , reaperStop = stop stateRef + , reaperKill = kill tidRef } where readRef stateRef = do @@ -125,31 +129,46 @@ case mx of NoReaper -> (NoReaper, reaperEmpty) Workload x -> (Workload reaperEmpty, x) - -update :: ReaperSettings workload item -> IORef (State workload) -> item - -> IO () -update settings@ReaperSettings{..} stateRef item = - mask_ $ join $ atomicModifyIORef' stateRef cons + kill tidRef = do + mtid <- readIORef tidRef + case mtid of + Nothing -> return () + Just tid -> killThread tid + +add :: ReaperSettings workload item + -> IORef (State workload) -> IORef (Maybe ThreadId) + -> item -> IO () +add settings@ReaperSettings{..} stateRef tidRef item = + mask_ $ do + next <- atomicModifyIORef' stateRef cons + next where - cons NoReaper = (Workload $ reaperCons item reaperEmpty - ,spawn settings stateRef) - cons (Workload wl) = (Workload $ reaperCons item wl - ,return ()) + cons NoReaper = let !wl = reaperCons item reaperEmpty + in (Workload wl, spawn settings stateRef tidRef) + cons (Workload wl) = let wl' = reaperCons item wl + in (Workload wl', return ()) + +spawn :: ReaperSettings workload item + -> IORef (State workload) -> IORef (Maybe ThreadId) + -> IO () +spawn settings stateRef tidRef = do + tid <- forkIO $ reaper settings stateRef tidRef + writeIORef tidRef $ Just tid -spawn :: ReaperSettings workload item -> IORef (State workload) -> IO () -spawn settings stateRef = void . forkIO $ reaper settings stateRef - -reaper :: ReaperSettings workload item -> IORef (State workload) -> IO () -reaper settings@ReaperSettings{..} stateRef = do +reaper :: ReaperSettings workload item + -> IORef (State workload) -> IORef (Maybe ThreadId) + -> IO () +reaper settings@ReaperSettings{..} stateRef tidRef = do threadDelay reaperDelay -- Getting the current jobs. Push an empty job to the reference. wl <- atomicModifyIORef' stateRef swapWithEmpty -- Do the jobs. A function to merge the left jobs and -- new jobs is returned. - merge <- reaperAction wl + !merge <- reaperAction wl -- Merging the left jobs and new jobs. -- If there is no jobs, this thread finishes. - join $ atomicModifyIORef' stateRef (check merge) + next <- atomicModifyIORef' stateRef (check merge) + next where swapWithEmpty NoReaper = error "Control.Reaper.reaper: unexpected NoReaper (1)" swapWithEmpty (Workload wl) = (Workload reaperEmpty, wl) @@ -157,9 +176,9 @@ check _ NoReaper = error "Control.Reaper.reaper: unexpected NoReaper (2)" check merge (Workload wl) -- If there is no job, reaper is terminated. - | reaperNull wl' = (NoReaper, return ()) + | reaperNull wl' = (NoReaper, writeIORef tidRef Nothing) -- If there are jobs, carry them out. - | otherwise = (Workload wl', reaper settings stateRef) + | otherwise = (Workload wl', reaper settings stateRef tidRef) where wl' = merge wl @@ -175,8 +194,8 @@ mkListAction f = go id where - go front [] = return front - go front (x:xs) = do + go !front [] = return front + go !front (x:xs) = do my <- f x let front' = case my of diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/auto-update-0.1.2.2/auto-update.cabal new/auto-update-0.1.3/auto-update.cabal --- old/auto-update-0.1.2.2/auto-update.cabal 2015-07-05 07:04:58.000000000 +0200 +++ new/auto-update-0.1.3/auto-update.cabal 2015-12-16 07:13:54.000000000 +0100 @@ -1,5 +1,5 @@ name: auto-update -version: 0.1.2.2 +version: 0.1.3 synopsis: Efficiently run periodic, on-demand actions description: API docs and the README are available at http://www.stackage.org/package/auto-update. homepage: https://github.com/yesodweb/wai