progress (empty) → 1.0
raw patch · 4 files changed
+137/−0 lines, 4 filesdep +basedep +timesetup-changed
Dependencies added: base, time
Files
- LICENSE +24/−0
- Setup.hs +2/−0
- System/Console/Progress.hs +92/−0
- progress.cabal +19/−0
+ LICENSE view
@@ -0,0 +1,24 @@+Copyright (c) 2009 marius a. eriksen (marius@monkey.org)+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. The names of the authors may not be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ System/Console/Progress.hs view
@@ -0,0 +1,92 @@+-- | Track & project progress of a process that is completing some+-- | units of work.+module System.Console.Progress+ ( Progress+ , empty+ , update+ , projectTimeLeft+ , progress+ , drawProgress+ ) where++-- TODO: +--+-- * have some generic String -> IO String for use eg. w/ interact to+-- automatically print progress in monad/arrow processes+--+-- * determine terminal width & proper escaping (eg. through vty), and+-- provide a function to deal with terminal output end-to-end++import Data.Time.Clock (diffUTCTime, UTCTime, getCurrentTime)+import Text.Printf (printf, PrintfArg)++data Progress a = Progress a a UTCTime Int++-- | The empty progress object.+empty :: (Num a) + => a -- ^ Total number of items to be completed.+ -> UTCTime -- ^ Start time+ -> Progress a+empty total now = Progress 0 total now 0++-- | Update the progress object with completed items.+update :: (Num a) + => a -- ^ Number of items completed+ -> Progress a -- ^ The progress object+ -> Progress a+update howmany (Progress count total time width) = + Progress (count + howmany) total time width++-- | Project the amount of time until completion in seconds.+projectTimeLeft :: (Integral a) + => UTCTime -- ^ The current time+ -> Progress a -- ^ The progress object+ -> Maybe a -- ^ Projected time in seconds+projectTimeLeft when (Progress count total time _) =+ maybe Nothing (\rate -> Just $ floor $ (toRational left) / rate) rate+ where+ left = total - count+ diffSecs = toRational $ diffUTCTime when time+ rate' = if diffSecs > 0 + then Just $ (toRational count) / diffSecs+ else Nothing+ rate = maybe + Nothing+ (\r -> if r > 0 then (Just r) else Nothing)+ rate'++-- | The amount of progress made, in whole percents.+progress :: (Integral a) + => Progress a -- ^ The progress object+ -> a -- ^ Whole percents+progress (Progress count total _ _)+ | total == 0 = 0+ | otherwise = (100 * count) `div` total++-- | A string to be printed on the console with the current progress &+-- | projected time to completion. The string contains terminal+-- | escapes to erase previous output exceeding the current output+-- | length.+drawProgress :: (PrintfArg a, Integral a)+ => UTCTime -- ^ The current time+ -> Progress a -- ^ The progress object+ -> (Progress a, String) -- ^ A new progress object & the+ -- ^ progress string+drawProgress when p@(Progress count total time width) =+ (Progress count total time width', str)+ where+ erase = replicate width ' ' ++ replicate width '\x08'+ str' = printf "%s done, remaining: %s" pct left+ width' = length str'+ str = erase ++ str'++ pct :: String+ pct = printf "%02d%%" $ progress p++ left :: String+ left = leftStr $ projectTimeLeft when p+ leftStr Nothing = "?"+ leftStr (Just s)+ | s < 60 = printf "%02ds" s+ | s < 3600 = printf "%02dm" (s `div` 60) ++ leftStr (Just (s `mod` 60))+ | otherwise = printf "%dh" (s `div` 3600) ++ leftStr (Just (s `mod` 3600))
+ progress.cabal view
@@ -0,0 +1,19 @@+cabal-version: >= 1.6+name: progress+version: 1.0+build-type: Simple+license: BSD3+license-file: LICENSE+author: marius a. eriksen+category: User Interfaces+synopsis: Simple progress tracking & projection library+description: Given a some "units of work" and points in time,+ we (linearly) project the time until completion + and also keep track of progress made thus far.+maintainer: marius a. eriksen+copyright: (c) 2009 marius a. eriksen++library+ build-depends: base == 4.*, time+ exposed-modules:+ System.Console.Progress