terminal-progress-bar-0.1.1.1/0000755000000000000000000000000013117174445014264 5ustar0000000000000000terminal-progress-bar-0.1.1.1/LICENSE0000644000000000000000000000275413117174445015301 0ustar0000000000000000Copyright 2012–2017 Roel van Dijk All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * 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. * The name of Roel van Dijk and the names of contributors may NOT be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 COPYRIGHT OWNER OR CONTRIBUTORS 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. terminal-progress-bar-0.1.1.1/example.hs0000644000000000000000000000133613117174445016256 0ustar0000000000000000{-# 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 "" terminal-progress-bar-0.1.1.1/terminal-progress-bar.cabal0000644000000000000000000000454713117174445021501 0ustar0000000000000000name: terminal-progress-bar version: 0.1.1.1 cabal-version: >=1.10 build-type: Simple stability: provisional author: Roel van Dijk maintainer: Roel van Dijk copyright: 2012–2014 Roel van Dijk license: BSD3 license-file: LICENSE category: System, User Interfaces homepage: https://github.com/roelvandijk/terminal-progress-bar bug-reports: https://github.com/roelvandijk/terminal-progress-bar/issues synopsis: A simple progress bar in the terminal description: A progress bar is used to convey the progress of a task. This package implements a very simple textual progress bar. . See the module 'System.ProgressBar' on how to use the progress bar or build the package with the -fexample flag for a small example program. . The animated progress bar depends entirely on the interpretation of the carriage return character (\'\\r\'). If your terminal interprets it as something else than \"move cursor to beginning of line\", the animation won't work. extra-source-files: LICENSE, README.markdown source-repository head type: git location: git://github.com/roelvandijk/terminal-progress-bar.git flag example description: Build a small example program. default: False library hs-source-dirs: src build-depends: base >= 3.0.3.1 && < 5.0 , 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 , HUnit >= 1.2.4.2 && < 1.6 , terminal-progress-bar , 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 buildable: True else buildable: False default-language: Haskell2010 terminal-progress-bar-0.1.1.1/Setup.hs0000644000000000000000000000005613117174445015721 0ustar0000000000000000import Distribution.Simple main = defaultMain terminal-progress-bar-0.1.1.1/README.markdown0000644000000000000000000000000013117174445016753 0ustar0000000000000000terminal-progress-bar-0.1.1.1/src/0000755000000000000000000000000013117174445015053 5ustar0000000000000000terminal-progress-bar-0.1.1.1/src/System/0000755000000000000000000000000013117174445016337 5ustar0000000000000000terminal-progress-bar-0.1.1.1/src/System/ProgressBar.hs0000644000000000000000000001513613117174445021132 0ustar0000000000000000{-# language PackageImports, NamedFieldPuns, RecordWildCards #-} module System.ProgressBar ( -- * Progress bars ProgressBar , progressBar , hProgressBar , mkProgressBar -- * Labels , Label , noLabel , msg , percentage , exact -- * Auto printing , ProgressRef , startProgress , incProgress ) where import "base" Control.Monad ( when ) import "base" Data.List ( genericLength, genericReplicate ) import "base" Data.Ratio ( (%) ) import "base" System.IO ( Handle, stderr, hPutChar, hPutStr, hFlush ) import "base" Text.Printf ( printf ) 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 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. 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 :: 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) '.' ) postPad postLabel where -- Amount of work completed. fraction :: Rational fraction | done /= 0 = todo % done | otherwise = 0 % 1 -- Amount of characters available to visualize the progress. effectiveWidth = max 0 $ width - usedSpace usedSpace = 2 + genericLength preLabel + genericLength postLabel + genericLength prePad + genericLength postPad -- 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 :: Rational numCompletedChars = fraction * (effectiveWidth % 1) completed, remaining :: Integer completed = min effectiveWidth $ floor numCompletedChars remaining = effectiveWidth - completed preLabel, postLabel :: String preLabel = mkPreLabel todo done postLabel = mkPostLabel todo done prePad, postPad :: String prePad = pad preLabel postPad = pad postLabel pad :: String -> String pad s | null s = "" | otherwise = " " -- | A label that can be pre- or postfixed to a progress bar. type Label = Integer -- ^ Completed amount of work. -> Integer -- ^ Total amount of work. -> String -- ^ Resulting label. -- | The empty label. -- -- >>> noLabel 30 100 -- "" noLabel :: Label noLabel = msg "" -- | A label consisting of a static string. -- -- >>> msg "foo" 30 100 -- "foo" msg :: String -> Label msg s _ _ = s -- | A label which displays the progress as a percentage. -- -- Constant width property: -- ∀ d t : ℕ. d ≤ t → length (percentage d t) ≡ 4 -- -- >>> percentage 30 100 -- " 30%" -- ∀ 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. -- -- Equal width property: -- ∀ d₁ d₂ t : ℕ. d₁ ≤ d₂ ≤ t → length (exact d₁ t) ≡ length (exact d₂ t) -- -- >>> exact 30 100 -- " 30/100" -- ∀ 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 :: 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. -> 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 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 -> Integer -> IO () incProgress progressRef = atomically . writeTMQueue (prQueue progressRef) 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 terminal-progress-bar-0.1.1.1/test/0000755000000000000000000000000013117174445015243 5ustar0000000000000000terminal-progress-bar-0.1.1.1/test/test.hs0000644000000000000000000000475513117174445016571 0ustar0000000000000000{-# language PackageImports #-} module Main where -------------------------------------------------------------------------------- -- Imports -------------------------------------------------------------------------------- import "base" System.Environment ( getArgs ) import "HUnit" Test.HUnit.Base ( assertEqual ) import "test-framework" Test.Framework ( defaultMainWithOpts, interpretArgsOrExit, Test, testGroup ) import "test-framework-hunit" Test.Framework.Providers.HUnit ( testCase ) import "terminal-progress-bar" System.ProgressBar ( mkProgressBar, Label, noLabel, msg, percentage, exact ) -------------------------------------------------------------------------------- -- Test suite -------------------------------------------------------------------------------- main :: IO () main = do opts <- interpretArgsOrExit =<< getArgs defaultMainWithOpts tests opts tests :: [Test] tests = [ testGroup "Label padding" [ eqTest "no labels" "[]" noLabel noLabel 0 0 0 , eqTest "pre" "pre []" (msg "pre") noLabel 0 0 0 , eqTest "post" "[] post" noLabel (msg "post") 0 0 0 , eqTest "pre & post" "pre [] post" (msg "pre") (msg "post") 0 0 0 ] , testGroup "Bar fill" [ eqTest "empty" "[....]" noLabel noLabel 6 0 1 , eqTest "almost half" "[=>..]" noLabel noLabel 6 49 100 , eqTest "half" "[==>.]" noLabel noLabel 6 1 2 , eqTest "almost full" "[===>]" noLabel noLabel 6 99 100 , eqTest "full" "[====]" noLabel noLabel 6 1 1 , eqTest "overfull" "[====]" noLabel noLabel 6 2 1 ] , testGroup "Labels" [ testGroup "Percentage" [ eqTest " 0%" " 0% [....]" percentage noLabel 11 0 1 , eqTest "100%" "100% [====]" percentage noLabel 11 1 1 , eqTest " 50%" " 50% [==>.]" percentage noLabel 11 1 2 , eqTest "200%" "200% [====]" percentage noLabel 11 2 1 ] , testGroup "Exact" [ eqTest "0/0" "0/0 [....]" exact noLabel 10 0 0 , eqTest "1/1" "1/1 [====]" exact noLabel 10 1 1 , eqTest "1/2" "1/2 [==>.]" exact noLabel 10 1 2 , eqTest "2/1" "2/1 [====]" exact noLabel 10 2 1 ] ] ] eqTest :: String -> String -> Label -> Label -> Integer -> Integer -> Integer -> Test eqTest name expected mkPreLabel mkPostLabel width todo done = testCase name $ assertEqual errMsg expected actual where actual = mkProgressBar mkPreLabel mkPostLabel width todo done errMsg = "Expected result doesn't match actual result"