[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

[John Goerzen]

The following commit has been merged in the master branch:
commit fc5e7ed6e428547f63ff70d798ca77c782716e1a
Author: John Goerzen <jgoerzen at complete.org>
Date:   Tue Oct 10 22:03:05 2006 +0100

    Added first increment

diff --git a/MissingH/ProgressTracker.hs b/MissingH/ProgressTracker.hs
index 5a44d65..d9a639f 100644
--- a/MissingH/ProgressTracker.hs
+++ b/MissingH/ProgressTracker.hs
@@ -36,8 +36,9 @@ module MissingH.ProgressTracker (-- * Types
                                  Progress, ProgressTimeSource,
                                  ProgressCallback,
                                  ProgressStatuses(..),
-                                 -- * Use
-                                 newProgress,
+                                 -- * Creation
+                                 newProgress, newProgress',
+                                 -- * Updating
                                  -- * Utilities
                                  defaultTimeSource
                                )
@@ -92,8 +93,9 @@ instance ProgressStatuses ProgressStatus b where
     withStatus x func = func x
 
 ----------------------------------------------------------------------
--- Use
+-- Creation
 ----------------------------------------------------------------------
+
 {- | Create a new 'Progress' object with the given name and number
 of total units initialized as given.  The start time will be initialized
 with the current time at the present moment according to the system clock.
@@ -124,6 +126,14 @@ newProgress' news newts newcb =
                                       callbacks = newcb, status = news}
        return (Progress r)
 
+----------------------------------------------------------------------
+-- Updating
+----------------------------------------------------------------------
+{- | Increment the completed unit count in the 'Progress' object
+by the amount given. -}
+incrP :: Progress -> Integer -> IO ()
+incrP po count = 
+    modStatus po (\s -> s {completedUnits = completedUnits s + count})
 
 ----------------------------------------------------------------------
 -- Utilities
@@ -138,3 +148,8 @@ defaultTimeSource = getClockTime >>= (return . clockTimeToEpoch)
 now :: ProgressRecords a ProgressTimeSource => a -> ProgressTimeSource
 now x = withRecord x timeSource
 
+modStatus :: Progress -> (ProgressStatus -> ProgressStatus) -> IO ()
+modStatus (Progress mp) func =
+    modifyMVar_ mp modfunc
+    where modfunc :: ProgressRecord -> IO ProgressRecord
+          modfunc pr = return $ pr {status = func (status pr)}
\ No newline at end of file

-- 
haskell-testpack