[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36
John Goerzen
jgoerzen at complete.org
Fri Apr 23 15:13:34 UTC 2010
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
More information about the Pkg-haskell-commits
mailing list