packages feed

progress (empty) → 1.0

raw patch · 4 files changed

+137/−0 lines, 4 filesdep +basedep +timesetup-changed

Dependencies added: base, time

Files

+ 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