[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 90c60a0e798f9d4b17d062c64899b43afc717c29
Author: John Goerzen <jgoerzen at complete.org>
Date:   Thu Nov 23 01:44:07 2006 +0100

    More renaming and various compilation fixes

diff --git a/MissingH/ProgressMeter.hs b/MissingH/ProgressMeter.hs
index aa9c3e9..9565fc2 100644
--- a/MissingH/ProgressMeter.hs
+++ b/MissingH/ProgressMeter.hs
@@ -17,7 +17,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 -}
 
 {- |
-   Module     : MissingH.StatusBar
+   Module     : MissingH.ProgressMeter
    Copyright  : Copyright (C) 2006 John Goerzen
    License    : GNU GPL, version 2 or above
 
@@ -38,35 +38,50 @@ import MissingH.ProgressTracker
 import Control.Concurrent.MVar
 import MissingH.Str
 import MissingH.Time
+import MissingH.Quantity
 
 data ProgressMeterR = 
-    ProgressMeterR {masterP :: ProgressTracker,
-               components :: [ProgressTracker],
-               width :: Int,
-               renderer :: Integer -> String}
+    ProgressMeterR {masterP :: Progress,
+                    components :: [Progress],
+                    width :: Int,
+                    renderer :: Integer -> String}
 
 type ProgressMeter = MVar ProgressMeterR
 
+{- | Set up a new status bar using defaults:
+
+* The given tracker
+* Width 80
+* MissingH.Quantity.renderNum binaryOpts 0
+-}
+simpleNewMeter :: Progress -> IO ProgressMeter
+simpleNewMeter pt = newMeter pt 80 (renderNum binaryOpts 0)
+
 {- | Set up a new status bar. -}
-newStatus :: ProgressTracker    -- ^ The top-level 'ProgressTracker'
+newMeter :: Progress           -- ^ The top-level 'Progress'
           -> Int                -- ^ Width of the terminal -- usually 80
           -> (Integer -> String)-- ^ A function to render sizes
-          -> IO Status
-newStatus tracker w rfunc = 
+          -> IO ProgressMeter
+newMeter tracker w rfunc = 
     newMVar $ ProgressMeterR {masterP = tracker, components = [],
                          width = w, renderer = rfunc}
 
+{- | Adjust the list of components of this 'ProgressMeter'. -}
+setComponents :: ProgressMeter -> [Progress] -> IO ()
+setComponents meter componentlist = modifyMVar_ meter (\m -> return $ m {components = componentlist})
+
 {- | Render the current status. -}
-renderMeter :: Status -> IO String
-renderMeter r = withMVar r $ \status ->
-    do overallpct <- renderpct (masterP status)
-       components <- mapM rendercomponent (renderer status) (components status)
+renderMeter :: ProgressMeter -> IO String
+renderMeter r = withMVar r $ \meter ->
+    do overallpct <- renderpct (masterP meter)
+       components <- mapM (rendercomponent (renderer meter))
+                     (components meter)
        let componentstr = case join " " components of
-                            [] -> ''
+                            [] -> ""
                             x -> x ++ " "
-       rightpart <- renderoverall (renderer status) (masterP status)
+       rightpart <- renderoverall (renderer meter) (masterP meter)
        let leftpart = overallpct ++ componentstr
-       let padwidth = (width status) - 1 - (length leftpart) - (length rightpart)
+       let padwidth = (width meter) - 1 - (length leftpart) - (length rightpart)
        if padwidth < 1
           then return $ leftpart ++ rightpart
           else return $ leftpart ++ replicate padwidth ' ' ++ rightpart
@@ -76,13 +91,16 @@ renderMeter r = withMVar r $ \status ->
           renderpctpts pts = 
                   if (totalUnits pts == 0)
                      then return "0% "
-                     else return $ sehow (((completedUnits pts) * 100) `div` (totalUnits pts)) ++ "% "
+                     else return $ show (((completedUnits pts) * 100) `div` (totalUnits pts)) ++ "% "
+          rendercomponent :: (Integer -> String) -> Progress -> IO String
           rendercomponent rfunc pt = withStatus pt $ \pts ->
-              return $ "[" ++ trackerName pt ++ " " ++
+              do pct <- renderpctpts pts
+                 return $ "[" ++ trackerName pts ++ " " ++
                      rfunc (completedUnits pts) ++ "/" ++
-                     rfunc (totalUnits pts) ++ " " ++
-                     renderpctpts pts ++ "]"
+                     rfunc (totalUnits pts) ++ " " ++ pct ++ "]"
           renderoverall rfunc pt = withStatus pt $ \pts ->
-              return $ (renderer . getSpeed) pts ++ "/s " ++
-                     (renderSecs . getETR $ pts)
+              do etr <- getETR pts
+                 speed <- getSpeed pts
+                 return $ rfunc speed ++ "/s " ++ renderSecs etr
+
 

-- 
haskell-testpack