[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 472895b956821974e7ad6ed25a0b279e229cf685
Author: John Goerzen <jgoerzen at complete.org>
Date:   Wed Oct 11 22:12:33 2006 +0100

    Wrote ETA, adjusted ETR

diff --git a/MissingH/ProgressTracker.hs b/MissingH/ProgressTracker.hs
index 2125502..c565f5e 100644
--- a/MissingH/ProgressTracker.hs
+++ b/MissingH/ProgressTracker.hs
@@ -45,7 +45,7 @@ module MissingH.ProgressTracker (-- * Types
                                  getSpeed,
                                  withStatus,
                                  getETR,
-                                 --getETA,
+                                 getETA,
                                  -- * Utilities
                                  defaultTimeSource
                                )
@@ -218,13 +218,24 @@ getSpeed po = withStatus po $ \status ->
 getETR :: (ProgressStatuses a (IO Integer),
            ProgressStatuses a (IO Rational)) => a -> IO Integer
 getETR po = 
-    do (speed::Rational) <- getSpeed po
+    do speed <- ((getSpeed po)::IO Rational)
        -- FIXME: potential for a race condition here, but it should
        -- be negligible
        withStatus po $ \status ->
            do let remaining = totalUnits status - completedUnits status
               return $ round $ (toRational remaining) / speed
 
+{- | Returns the estimated system clock time of completion, in standard
+time units. -}
+getETA :: (ProgressStatuses a (IO Integer),
+           ProgressStatuses a (IO Rational)) => a -> IO Integer
+getETA po =
+    do etr <- getETR po
+       -- FIXME: similar race potential here
+       withStatus po $ \status ->
+           do timenow <- timeSource status
+              return $ timenow + etr
+
 ----------------------------------------------------------------------
 -- Utilities
 ----------------------------------------------------------------------

-- 
haskell-testpack