terminal-progress-bar 0.0.1.4 → 0.1.0

raw patch · 4 files changed

+148/−126 lines, 4 filesdep −base-unicode-symbolsdep ~HUnitdep ~basedep ~terminal-progress-barnew-component:exe:examplePVP ok

version bump matches the API change (PVP)

Dependencies removed: base-unicode-symbols

Dependency ranges changed: HUnit, base, terminal-progress-bar

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• example.hs +28/−0
• src/System/ProgressBar.hs +94/−97
• terminal-progress-bar.cabal +25/−28

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

@@ -0,0 +1,28 @@+{-# LANGUAGE PackageImports #-}++module Main where++import "base" Control.Concurrent ( threadDelay )+import "base" Control.Monad ( forM_ )+import "terminal-progress-bar" System.ProgressBar+    ( progressBar, percentage, exact, startProgress, incProgress )++main :: IO ()+main = do+  example  60 (13 + 60) 25000+  example' 60 (13 + 60) 25000++example :: Integer -> Integer -> Int -> IO ()+example t w delay = do+    forM_ [1..t] $ \d -> do+      progressBar percentage exact w d t+      threadDelay delay+    putStrLn ""++example' :: Integer -> Integer -> Int -> IO ()+example' t w delay = do+    (pr, _) <- startProgress percentage exact w t+    forM_ [1..t] $ \_d -> do+      incProgress pr 1+      threadDelay delay+    putStrLn ""

@@ -1,8 +1,10 @@-{-# LANGUAGE NoImplicitPrelude, PackageImports, NamedFieldPuns, RecordWildCards, UnicodeSyntax #-}+{-# language PackageImports, NamedFieldPuns, RecordWildCards #-}  module System.ProgressBar     ( -- * Progress bars-      progressBar+      ProgressBar+    , progressBar+    , hProgressBar     , mkProgressBar       -- * Labels     , Label@@ -10,77 +12,69 @@     , msg     , percentage     , exact-    -- * auto-printing+      -- * Auto printing     , ProgressRef     , startProgress     , incProgress     ) where -import "base" Control.Monad ( (=<<), (>>), return, when )-import "base" Data.Bool     ( otherwise )-import "base" Data.Function ( ($), (.) )-import "base" Data.List     ( null, length, genericLength, genericReplicate )-import "base" Data.Maybe    ( maybe )-import "base" Data.Ord      ( min, max, (>=) )+import "base" Control.Monad ( when )+import "base" Data.List     ( genericLength, genericReplicate ) import "base" Data.Ratio    ( (%) )-import "base" Data.String   ( String )-import "base" Prelude       ( (+), (-), round, floor, Bool(..) )-import "base" System.IO     ( IO, putStr, putChar )+import "base" System.IO     ( Handle, stderr, hPutChar, hPutStr, hFlush ) 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   ( ℤ, ℚ, (⋅) )+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 ) +-- | Type of functions producing a progress bar.+type ProgressBar a+   = Label   -- ^ Prefixed label.+  -> Label   -- ^ Postfixed label.+  -> Integer -- ^ Total progress bar width in characters.+  -> Integer -- ^ Amount of work completed.+  -> Integer -- ^ Total amount of work.+  -> a --- | Print a progress bar+-- | Print a progress bar to 'stderr' --+-- See 'hProgressBar'.+progressBar :: ProgressBar (IO ())+progressBar = hProgressBar stderr++-- | Print a progress bar to a file handle.+-- -- Erases the current line! (by outputting '\r') Does not print a -- newline '\n'. Subsequent invocations will overwrite the previous -- output.------ Remember to set the correct buffering mode for stdout:------ > import System.IO ( hSetBuffering, BufferMode(NoBuffering), stdout )--- > hSetBuffering stdout NoBuffering-progressBar ∷ Label -- ^ Prefixed label.-            → Label -- ^ Postfixed label.-            → ℤ     -- ^ Total progress bar width in characters.-            → ℤ     -- ^ Amount of work completed.-            → ℤ     -- ^ Total amount of work.-            → IO ()-progressBar mkPreLabel mkPostLabel width todo done = do-    putChar '\r'-    putStr $ mkProgressBar mkPreLabel mkPostLabel width todo done+hProgressBar :: Handle -> ProgressBar (IO ())+hProgressBar hndl mkPreLabel mkPostLabel width todo done = do+    hPutChar hndl '\r'+    hPutStr hndl $ mkProgressBar mkPreLabel mkPostLabel width todo done+    hFlush hndl  -- | Renders a progress bar -- -- >>> mkProgressBar (msg "Working") percentage 40 30 100 -- "Working [=======>.................]  30%"-mkProgressBar ∷ Label -- ^ Prefixed label.-              → Label -- ^ Postfixed label.-              → ℤ     -- ^ Total progress bar width in characters.-              → ℤ     -- ^ Amount of work completed.-              → ℤ     -- ^ Total amount of work.-              → String+mkProgressBar :: ProgressBar String mkProgressBar mkPreLabel mkPostLabel width todo done =     printf "%s%s[%s%s%s]%s%s"            preLabel            prePad            (genericReplicate completed '=')-           (if remaining ≢ 0 ∧ completed ≢ 0 then ">" else "")-           (genericReplicate (remaining - if completed ≢ 0 then 1 else 0)+           (if remaining /= 0 && completed /= 0 then ">" else "")+           (genericReplicate (remaining - if completed /= 0 then 1 else 0)                              '.'            )            postPad            postLabel   where     -- Amount of work completed.-    fraction ∷ ℚ-    fraction | done ≢ 0  = todo % done+    fraction :: Rational+    fraction | done /= 0  = todo % done              | otherwise = 0 % 1      -- Amount of characters available to visualize the progress.@@ -93,41 +87,44 @@     -- Number of characters needed to represent the amount of work     -- that is completed. Note that this can not always be represented     -- by an integer.-    numCompletedChars ∷ ℚ-    numCompletedChars = fraction ⋅ (effectiveWidth % 1)+    numCompletedChars :: Rational+    numCompletedChars = fraction * (effectiveWidth % 1) -    completed, remaining ∷ ℤ+    completed, remaining :: Integer     completed = min effectiveWidth $ floor numCompletedChars     remaining = effectiveWidth - completed -    preLabel, postLabel ∷ String+    preLabel, postLabel :: String     preLabel  = mkPreLabel  todo done     postLabel = mkPostLabel todo done -    prePad, postPad ∷ String+    prePad, postPad :: String     prePad  = pad preLabel     postPad = pad postLabel -    pad ∷ String → String+    pad :: String -> String     pad s | null s    = ""           | otherwise = " "   -- | A label that can be pre- or postfixed to a progress bar.-type Label = ℤ → ℤ → String+type Label+   = Integer -- ^ Completed amount of work.+  -> Integer -- ^ Total amount of work.+  -> String  -- ^ Resulting label.  -- | The empty label. -- -- >>> noLabel 30 100 -- ""-noLabel ∷ Label+noLabel :: Label noLabel = msg ""  -- | A label consisting of a static string. -- -- >>> msg "foo" 30 100 -- "foo"-msg ∷ String → Label+msg :: String -> Label msg s _ _ = s  -- | A label which displays the progress as a percentage.@@ -138,9 +135,9 @@ -- >>> percentage 30 100 -- " 30%" --- ∀ d t : ℕ. d ≤ t → length (percentage d t) ≡ 3-percentage ∷ Label-percentage done todo = printf "%3i%%" (round (done % todo ⋅ 100) ∷ ℤ)+-- ∀ d t : ℕ. d ≤ t -> length (percentage d t) ≡ 3+percentage :: Label+percentage done todo = printf "%3i%%" (round (done % todo * 100) :: Integer)  -- | A label which displays the progress as a fraction of the total -- amount of work.@@ -151,28 +148,32 @@ -- >>> exact 30 100 -- " 30/100" --- ∀ d₁ d₂ t : ℕ. d₁ ≤ d₂ ≤ t → length (exact d₁ t) ≡ length (exact d₂ t)-exact ∷ Label+-- ∀ d₁ d₂ t : ℕ. d₁ ≤ d₂ ≤ t -> length (exact d₁ t) ≡ length (exact d₂ t)+exact :: Label 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 ℤ }+data ProgressRef+   = ProgressRef+     { prPrefix    :: Label+     , prPostfix   :: Label+     , prWidth     :: Integer+     , prCompleted :: TVar Integer+     , prTotal     :: Integer+     , prQueue     :: TMQueue Integer+     }  -- | 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+    :: Label   -- ^ Prefixed label.+    -> Label   -- ^ Postfixed label.+    -> Integer -- ^ Total progress bar width in characters.+    -> Integer -- ^ Total amount of work.+    -> IO (ProgressRef, ThreadId) startProgress mkPreLabel mkPostLabel width total = do     pr  <- buildProgressRef     tid <- forkIO $ reportProgress pr@@ -184,36 +185,32 @@         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+-- Progress will never be negative and will silently stop taking data+-- when it completes.+incProgress :: ProgressRef -> Integer -> IO ()+incProgress progressRef =+    atomically . writeTMQueue (prQueue progressRef) -reportProgress ∷ ProgressRef-               → IO ()+reportProgress :: ProgressRef -> IO () reportProgress pr = do-  continue <- atomically $ updateProgress pr-  renderProgress pr-  when continue $ reportProgress pr+    continue <- atomically $ updateProgress pr+    renderProgress pr+    when continue $ reportProgress pr -updateProgress ∷ ProgressRef-               → STM Bool+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 ()+    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+    completed <- atomically $ readTVar prCompleted+    progressBar prPrefix prPostfix prWidth completed prTotal

@@ -1,6 +1,6 @@ name:          terminal-progress-bar-version:       0.0.1.4-cabal-version: >=1.8+version:       0.1.0+cabal-version: >=1.10 build-type:    Simple stability:     provisional author:        Roel van Dijk <vandijk.roel@gmail.com>@@ -24,10 +24,6 @@   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-  uncomment the example section in the cabal file. But uncommenting-  that section will result in \"cabal haddock\" failing.  extra-source-files: LICENSE, README.markdown @@ -42,32 +38,33 @@ library     hs-source-dirs: src     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+    default-language: Haskell2010 -test-suite test-terminal-progress-bar-  type: exitcode-stdio-1.0-  main-is: test.hs-  hs-source-dirs: test-  ghc-options: -Wall-  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-               , test-framework        >= 0.3.3   && < 0.9-               , test-framework-hunit  >= 0.2.6   && < 0.4 --- executable example---   main-is: example.hs---   hs-source-dirs: .---   if flag(example)---     build-depends: base                  >= 3.0.3.1 && < 4.6---                  , base-unicode-symbols  >= 0.2.2.3 && < 0.3---                  , terminal-progress-bar == 0.0.1---     buildable: True---   else---     buildable: False+test-suite test-terminal-progress-bar+    type: exitcode-stdio-1.0+    main-is: test.hs+    hs-source-dirs: test+    ghc-options: -Wall+    build-depends: base                  >= 3.0.3.1 && < 5.0+                 , HUnit                 >= 1.2.4.2 && < 1.4+                 , terminal-progress-bar == 0.1.0+                 , test-framework        >= 0.3.3   && < 0.9+                 , test-framework-hunit  >= 0.2.6   && < 0.4+    default-language: Haskell2010 +executable example+    main-is: example.hs+    hs-source-dirs: .+    ghc-options: -Wall+    if flag(example)+      build-depends: base                  >= 3.0.3.1 && < 5.0+                   , terminal-progress-bar == 0.1.0+      buildable: True+    else+      buildable: False+    default-language: Haskell2010