terminal-progress-bar 0.0.1.3 → 0.0.1.4

raw patch · 3 files changed

+83/−11 lines, 3 filesdep +stmdep +stm-chansdep ~basePVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependencies added: stm, stm-chans

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• src/System/ProgressBar.hs +74/−4
• terminal-progress-bar.cabal +8/−6

@@ -1,4 +1,4 @@-Copyright 2012 Roel van Dijk+Copyright 2012–2014 Roel van Dijk  All rights reserved. 

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude, PackageImports, UnicodeSyntax #-}+{-# LANGUAGE NoImplicitPrelude, PackageImports, NamedFieldPuns, RecordWildCards, UnicodeSyntax #-}  module System.ProgressBar     ( -- * Progress bars@@ -10,18 +10,27 @@     , msg     , percentage     , exact+    -- * auto-printing+    , ProgressRef+    , startProgress+    , incProgress     ) where +import "base" Control.Monad ( (=<<), (>>), return, when ) import "base" Data.Bool     ( otherwise )-import "base" Data.Function ( ($) )+import "base" Data.Function ( ($), (.) ) import "base" Data.List     ( null, length, genericLength, genericReplicate )-import "base" Data.Ord      ( min, max )+import "base" Data.Maybe    ( maybe )+import "base" Data.Ord      ( min, max, (>=) ) import "base" Data.Ratio    ( (%) ) import "base" Data.String   ( String )-import "base" Prelude       ( (+), (-), round, floor )+import "base" Prelude       ( (+), (-), round, floor, Bool(..) ) import "base" System.IO     ( IO, putStr, putChar ) import "base" Text.Printf   ( printf ) import "base" Text.Show     ( show )+import "base"  Control.Concurrent ( ThreadId, forkIO )+import "stm"  Control.Concurrent.STM ( TVar, readTVar, writeTVar, newTVar, atomically, STM )+import "stm-chans"  Control.Concurrent.STM.TMQueue ( TMQueue, readTMQueue, closeTMQueue, writeTMQueue, newTMQueue ) import "base-unicode-symbols" Data.Bool.Unicode ( (∧) ) import "base-unicode-symbols" Data.Eq.Unicode   ( (≢) ) import "base-unicode-symbols" Prelude.Unicode   ( ℤ, ℚ, (⋅) )@@ -147,3 +156,64 @@ exact done total = printf "%*i/%s" (length totalStr) done totalStr   where     totalStr = show total++-- * Auto-Printing Progress++data ProgressRef = ProgressRef { prPrefix    ∷ Label+                               , prPostfix   ∷ Label+                               , prWidth     ∷ ℤ+                               , prCompleted ∷ TVar ℤ+                               , prTotal     ∷ ℤ+                               , prQueue     ∷ TMQueue ℤ }++-- | Start a thread to automatically display progress. Use incProgress to step+-- the progress bar.+startProgress ∷ Label -- ^ Prefixed label.+              → Label -- ^ Postfixed label.+              → ℤ     -- ^ Total progress bar width in characters.+              → ℤ     -- ^ Total amount of work.+              → IO (ProgressRef, ThreadId)+startProgress mkPreLabel mkPostLabel width total = do+    pr  <- buildProgressRef+    tid <- forkIO $ reportProgress pr+    return (pr, tid)+    where+      buildProgressRef = do+        completed <- atomically $ newTVar 0+        queue     <- atomically $ newTMQueue+        return $ ProgressRef mkPreLabel mkPostLabel width completed total queue++-- | Increment the progress bar. Negative values will reverse the progress.+-- Progress will never be negative and will silently stop taking data when it+-- completes.+incProgress ∷ ProgressRef+            → ℤ+            → IO ()+incProgress ProgressRef {prQueue} = atomically . writeTMQueue prQueue++reportProgress ∷ ProgressRef+               → IO ()+reportProgress pr = do+  continue <- atomically $ updateProgress pr+  renderProgress pr+  when continue $ reportProgress pr++updateProgress ∷ ProgressRef+               → STM Bool+updateProgress ProgressRef {prCompleted, prQueue, prTotal} = do+  maybe dontContinue doUpdate =<< readTMQueue prQueue+  where+    dontContinue = return False+    doUpdate countDiff = do+      count <- readTVar prCompleted+      let newCount = min prTotal $ max 0 $ count + countDiff+      writeTVar prCompleted newCount+      if newCount >= prTotal+        then closeTMQueue prQueue >> dontContinue+        else return True+                       +renderProgress ∷ ProgressRef+               → IO ()+renderProgress ProgressRef {..} = do+  completed <- atomically $ readTVar prCompleted+  progressBar prPrefix prPostfix prWidth completed prTotal

@@ -1,11 +1,11 @@ name:          terminal-progress-bar-version:       0.0.1.3+version:       0.0.1.4 cabal-version: >=1.8 build-type:    Simple stability:     provisional author:        Roel van Dijk <vandijk.roel@gmail.com> maintainer:    Roel van Dijk <vandijk.roel@gmail.com>-copyright:     2012 Roel van Dijk <vandijk.roel@gmail.com>+copyright:     2012–2014 Roel van Dijk <vandijk.roel@gmail.com> license:       BSD3 license-file:  LICENSE category:      System, User Interfaces@@ -21,8 +21,8 @@   program.   .   The animated progress bar depends entirely on the interpretation of-  the carriage return character (\'\r\'). If your terminal interprets-  it as something else then "move cursor to beginning of line", the+  the carriage return character (\'\\r\'). If your terminal interprets+  it as something else then \"move cursor to beginning of line\", the   animation won't work.   .   Note: Due to a bug in \"cabal haddock\" you will have to manually@@ -41,8 +41,10 @@  library     hs-source-dirs: src-    build-depends: base                 >= 3.0.3.1 && < 4.7+    build-depends: base                 >= 3.0.3.1 && < 5.0                  , base-unicode-symbols >= 0.2.2.3 && < 0.3+                 , stm                  >= 2.4     && < 3.0+                 , stm-chans            >= 3.0.0   && < 4.0     exposed-modules: System.ProgressBar     ghc-options: -Wall @@ -51,7 +53,7 @@   main-is: test.hs   hs-source-dirs: test   ghc-options: -Wall-  build-depends: base                  >= 3.0.3.1 && < 4.7+  build-depends: base                  >= 3.0.3.1 && < 5.0                , base-unicode-symbols  >= 0.2.2.3 && < 0.3                , HUnit                 >= 1.2.4.2 && < 1.3                , terminal-progress-bar