diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright 2012–2017 Roel van Dijk +Copyright 2012–2018 Roel van Dijk All rights reserved. diff --git a/example.hs b/example.hs --- a/example.hs +++ b/example.hs @@ -2,27 +2,55 @@ module Main where +import "async" Control.Concurrent.Async ( async, wait ) import "base" Control.Concurrent ( threadDelay ) import "base" Control.Monad ( forM_ ) +import "base" Data.Functor ( void ) +import "random" System.Random ( randomRIO ) 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 60 (13 + 60) 25000 + exampleAsync 60 (13 + 60) 25000 + exampleAsync2 (13 + 100) 25000 example :: Integer -> Integer -> Int -> IO () -example t w delay = do - forM_ [1..t] $ \d -> do - progressBar percentage exact w d t +example todo width delay = do + forM_ [1 .. todo] $ \done -> do + autoProgressBar percentage exact width $ Progress done todo threadDelay delay putStrLn "" -example' :: Integer -> Integer -> Int -> IO () -example' t w delay = do - (pr, _) <- startProgress percentage exact w t - forM_ [1..t] $ \_d -> do +exampleAsync :: Integer -> Integer -> Int -> IO () +exampleAsync todo width delay = do + (pr, a) <- startProgress percentage exact width $ Progress 0 todo + forM_ [1 .. todo] $ \_done -> do incProgress pr 1 threadDelay delay + wait a putStrLn "" + +exampleAsync2 :: Integer -> Int -> IO () +exampleAsync2 width delay = do + (pr, a) <- startProgress percentage exact width $ Progress 0 todo + -- Spawn some threads which each increment progress a bit. + forM_ [1 .. numThreads] $ \_ -> + void $ async $ + forM_ [1 .. progressPerThread] $ \_ -> do + incProgress pr 1 + d <- randomRIO (delay * numThreads, 2 * delay * numThreads) + threadDelay d + + -- Wait until the task is completed. + wait a + putStrLn "" + where + todo :: Integer + todo = fromIntegral $ numThreads * progressPerThread + + numThreads :: Int + numThreads = 10 + + progressPerThread :: Int + progressPerThread = 10 diff --git a/src/System/ProgressBar.hs b/src/System/ProgressBar.hs --- a/src/System/ProgressBar.hs +++ b/src/System/ProgressBar.hs @@ -1,11 +1,14 @@ -{-# language PackageImports, NamedFieldPuns, RecordWildCards #-} +{-# language PackageImports #-} module System.ProgressBar ( -- * Progress bars ProgressBar , progressBar + , autoProgressBar , hProgressBar , mkProgressBar + -- * Progress state + , Progress(..) -- * Labels , Label , noLabel @@ -18,24 +21,22 @@ , 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 ) +import "async" Control.Concurrent.Async ( Async ) +import "base" System.IO ( Handle, stderr ) +import "this" System.ProgressBar.State ( Progress(..) ) +import qualified "this" System.ProgressBar.State as State -- | 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. + = Label -- ^ Prefixed label. + -> Label -- ^ Postfixed label. + -> Integer + -- ^ Total progress bar width in characters. Either used as given + -- or as a default when the width of the terminal can not be + -- determined. + -- + -- See 'autoProgressBar'. + -> Progress -- ^ Current progress. -> a -- | Print a progress bar to 'stderr' @@ -44,88 +45,48 @@ progressBar :: ProgressBar (IO ()) progressBar = hProgressBar stderr +-- | Print a progress bar to 'stderr' which takes up all available space. +-- +-- The given width will be used if the width of the terminal can not +-- be determined. +-- +-- See 'hProgressBar'. +autoProgressBar :: ProgressBar (IO ()) +autoProgressBar = State.autoProgressBar + -- | 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 +hProgressBar = State.hProgressBar -- | 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 = " " - +mkProgressBar = State.mkProgressBar -- | 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. + = Progress -- ^ Current progress. + -> String -- ^ Resulting label. -- | The empty label. -- -- >>> noLabel 30 100 -- "" noLabel :: Label -noLabel = msg "" +noLabel = State.noLabel -- | A label consisting of a static string. -- -- >>> msg "foo" 30 100 -- "foo" msg :: String -> Label -msg s _ _ = s +msg = State.msg -- | A label which displays the progress as a percentage. -- @@ -134,10 +95,13 @@ -- -- >>> percentage 30 100 -- " 30%" +-- +-- __Note__: if no work is to be done (todo == 0) the percentage will +-- always be 100%. -- ∀ d t : ℕ. d ≤ t -> length (percentage d t) ≡ 3 percentage :: Label -percentage done todo = printf "%3i%%" (round (done % todo * 100) :: Integer) +percentage = State.percentage -- | A label which displays the progress as a fraction of the total -- amount of work. @@ -150,67 +114,28 @@ -- ∀ 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 +exact = State.exact -- * Auto-Printing Progress -data ProgressRef - = ProgressRef - { prPrefix :: Label - , prPostfix :: Label - , prWidth :: Integer - , prCompleted :: TVar Integer - , prTotal :: Integer - , prQueue :: TMQueue Integer - } +type ProgressRef = State.ProgressRef Progress -- | 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 + :: Label -- ^ Prefixed label. + -> Label -- ^ Postfixed label. + -> Integer + -- ^ Total progress bar width in characters. Only used if the + -- width can not be automatically determined. + -> Progress -- ^ Initial progress state. + -> IO (ProgressRef, Async ()) +startProgress = State.startProgress -- | 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 +incProgress pr amount = + State.incProgress pr + (\st -> st { progressDone = progressDone st + amount }) diff --git a/src/System/ProgressBar/State.hs b/src/System/ProgressBar/State.hs new file mode 100644 --- /dev/null +++ b/src/System/ProgressBar/State.hs @@ -0,0 +1,280 @@ +{-# language PackageImports #-} +{-# OPTIONS_HADDOCK not-home #-} + +module System.ProgressBar.State + ( -- * Progress bars + ProgressBar + , progressBar + , autoProgressBar + , hProgressBar + , mkProgressBar + -- * Progress state + , Progress(..) + , HasProgress(..) + -- * Labels + , Label + , noLabel + , msg + , percentage + , exact + -- * Auto printing + , ProgressRef + , startProgress + , incProgress + ) where + +import "async" Control.Concurrent.Async ( Async, async ) +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 "stm" Control.Concurrent.STM + ( TVar, readTVar, writeTVar, newTVar, atomically, STM ) +import "stm-chans" Control.Concurrent.STM.TMQueue + ( TMQueue, readTMQueue, closeTMQueue, writeTMQueue, newTMQueue ) +import qualified "terminal-size" System.Console.Terminal.Size as TS + +-- | Type of functions producing a progress bar. +type ProgressBar s a + = Label s -- ^ Prefixed label. + -> Label s -- ^ Postfixed label. + -> Integer + -- ^ Total progress bar width in characters. Either used as given + -- or as a default when the width of the terminal can not be + -- determined. + -- + -- See 'autoProgressBar'. + -> s -- ^ Progress bar state. + -> a + +-- | Print a progress bar to 'stderr' +-- +-- See 'hProgressBar'. +progressBar :: (HasProgress s) => ProgressBar s (IO ()) +progressBar = hProgressBar stderr + +-- | Print a progress bar to 'stderr' which takes up all available space. +-- +-- The given width will be used if the width of the terminal can not +-- be determined. +-- +-- See 'hProgressBar'. +autoProgressBar :: (HasProgress s) => ProgressBar s (IO ()) +autoProgressBar mkPreLabel mkPostLabel defaultWidth st = do + mbWindow <- TS.size + let width = maybe defaultWidth TS.width mbWindow + progressBar mkPreLabel mkPostLabel width st + +-- | 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 :: HasProgress s => Handle -> ProgressBar s (IO ()) +hProgressBar hndl mkPreLabel mkPostLabel width st = do + hPutChar hndl '\r' + hPutStr hndl $ mkProgressBar mkPreLabel mkPostLabel width st + hFlush hndl + +-- | Renders a progress bar +-- +-- >>> mkProgressBar (msg "Working") percentage 40 30 100 +-- "Working [=======>.................] 30%" +mkProgressBar :: (HasProgress s) => ProgressBar s String +mkProgressBar mkPreLabel mkPostLabel width st = + 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 + progress = getProgress st + todo = progressTodo progress + done = progressDone progress + + -- Amount of work completed. + fraction :: Rational + fraction | todo /= 0 = done % todo + | 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 st + postLabel = mkPostLabel st + + prePad, postPad :: String + prePad = pad preLabel + postPad = pad postLabel + + pad :: String -> String + pad s | null s = "" + | otherwise = " " + +-- | State of a progress bar. +data Progress + = Progress + { progressDone :: !Integer + -- ^ Amount of work completed. + , progressTodo :: !Integer + -- ^ Total amount of work. + } + +-- | Types that can represent progress. +-- +-- Any progress bar state that implements this class can be used by +-- the default label functions. +class HasProgress a where + getProgress :: a -> Progress + +instance HasProgress Progress where + getProgress = id + +-- | A label that can be pre- or postfixed to a progress bar. +type Label s + = s -- ^ Current progress bar state. + -> String -- ^ Resulting label. + +-- | The empty label. +-- +-- >>> noLabel st +-- "" +noLabel :: Label s +noLabel = msg "" + +-- | A label consisting of a static string. +-- +-- >>> msg "foo" st +-- "foo" +msg :: String -> Label s +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%" +-- +-- __Note__: if no work is to be done (todo == 0) the percentage will +-- always be 100%. + +-- ∀ d t : ℕ. d ≤ t -> length (percentage d t) ≡ 3 +percentage :: HasProgress s => Label s +percentage s + | todo == 0 = "100%" + | otherwise = printf "%3i%%" (round (done % todo * 100) :: Integer) + where + done = progressDone progress + todo = progressTodo progress + progress = getProgress s + +-- | 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 :: HasProgress s => Label s +exact s = printf "%*i/%s" (length totalStr) done totalStr + where + totalStr = show todo + done = progressDone progress + todo = progressTodo progress + progress = getProgress s + + +-- * Auto-Printing Progress + +data ProgressRef s + = ProgressRef + { prPrefix :: !(Label s) + , prPostfix :: !(Label s) + , prWidth :: !Integer + , prState :: !(TVar s) + , prQueue :: !(TMQueue (s -> s)) + } + +-- | Start a thread to automatically display progress. Use incProgress to step +-- the progress bar. +startProgress + :: (HasProgress s) + => Label s -- ^ Prefixed label. + -> Label s -- ^ Postfixed label. + -> Integer -- ^ Total progress bar width in characters. + -> s -- ^ Init state + -> IO (ProgressRef s, Async ()) +startProgress mkPreLabel mkPostLabel width st = do + pr <- buildProgressRef + a <- async $ reportProgress pr + return (pr, a) + where + buildProgressRef = do + tvSt <- atomically $ newTVar st + queue <- atomically $ newTMQueue + return $ ProgressRef mkPreLabel mkPostLabel width tvSt 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 s -> (s -> s) -> IO () +incProgress progressRef = + atomically . writeTMQueue (prQueue progressRef) + +reportProgress :: (HasProgress s) => ProgressRef s -> IO () +reportProgress pr = do + continue <- atomically $ updateProgress pr + renderProgress pr + when continue $ reportProgress pr + +updateProgress :: (HasProgress s) => ProgressRef s -> STM Bool +updateProgress pr = + maybe dontContinue doUpdate =<< readTMQueue (prQueue pr) + where + dontContinue = return False + doUpdate updateState = do + st <- readTVar $ prState pr + let newState = updateState st + progress = getProgress newState + todo = progressTodo progress + done = progressDone progress + let newDone = min todo $ max 0 done + writeTVar (prState pr) newState + if newDone >= todo + then closeTMQueue (prQueue pr) >> dontContinue + else return True + +renderProgress :: (HasProgress s) => ProgressRef s -> IO () +renderProgress pr = do + st <- atomically $ readTVar $ prState pr + autoProgressBar + (prPrefix pr) + (prPostfix pr) + (prWidth pr) + st diff --git a/terminal-progress-bar.cabal b/terminal-progress-bar.cabal --- a/terminal-progress-bar.cabal +++ b/terminal-progress-bar.cabal @@ -1,11 +1,11 @@ name: terminal-progress-bar -version: 0.1.1.1 +version: 0.1.2 cabal-version: >=1.10 build-type: Simple stability: provisional author: Roel van Dijk maintainer: Roel van Dijk -copyright: 2012–2014 Roel van Dijk +copyright: 2012–2018 Roel van Dijk license: BSD3 license-file: LICENSE category: System, User Interfaces @@ -37,10 +37,14 @@ 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 + build-depends: + async >= 2.1.1 + , base >= 3.0.3.1 && < 5 + , stm >= 2.4 + , stm-chans >= 3.0.0 + , terminal-size >= 0.3.2 exposed-modules: System.ProgressBar + System.ProgressBar.State ghc-options: -Wall default-language: Haskell2010 @@ -49,11 +53,12 @@ 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 + build-depends: + base >= 3.0.3.1 && < 5 + , HUnit >= 1.2.4.2 + , terminal-progress-bar + , test-framework >= 0.3.3 + , test-framework-hunit >= 0.2.6 default-language: Haskell2010 executable example @@ -61,8 +66,11 @@ hs-source-dirs: . ghc-options: -Wall if flag(example) - build-depends: base >= 3.0.3.1 && < 5.0 - , terminal-progress-bar + build-depends: + async >= 2.1.1 + , base >= 3.0.3.1 && < 5 + , random >= 1.1 + , terminal-progress-bar buildable: True else buildable: False diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -12,7 +12,6 @@ ( 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 @@ -25,38 +24,46 @@ 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 + [ eqTest "no labels" "[]" noLabel noLabel 0 $ Progress 0 0 + , eqTest "pre" "pre []" (msg "pre") noLabel 0 $ Progress 0 0 + , eqTest "post" "[] post" noLabel (msg "post") 0 $ Progress 0 0 + , eqTest "pre & post" "pre [] post" (msg "pre") (msg "post") 0 $ Progress 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 + [ eqTest "empty" "[....]" noLabel noLabel 6 $ Progress 0 1 + , eqTest "almost half" "[=>..]" noLabel noLabel 6 $ Progress 49 100 + , eqTest "half" "[==>.]" noLabel noLabel 6 $ Progress 1 2 + , eqTest "almost full" "[===>]" noLabel noLabel 6 $ Progress 99 100 + , eqTest "full" "[====]" noLabel noLabel 6 $ Progress 1 1 + , eqTest "overfull" "[====]" noLabel noLabel 6 $ Progress 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 + [ eqTest " 0%" " 0% [....]" percentage noLabel 11 $ Progress 0 1 + , eqTest "100%" "100% [====]" percentage noLabel 11 $ Progress 1 1 + , eqTest " 50%" " 50% [==>.]" percentage noLabel 11 $ Progress 1 2 + , eqTest "200%" "200% [====]" percentage noLabel 11 $ Progress 2 1 + , labelTest "0 work todo" percentage (Progress 10 0) "100%" ] , 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 "0/0" "0/0 [....]" exact noLabel 10 $ Progress 0 0 + , eqTest "1/1" "1/1 [====]" exact noLabel 10 $ Progress 1 1 + , eqTest "1/2" "1/2 [==>.]" exact noLabel 10 $ Progress 1 2 + , eqTest "2/1" "2/1 [====]" exact noLabel 10 $ Progress 2 1 + , labelTest "0 work todo" exact (Progress 10 0) "10/0" ] ] ] -eqTest :: String -> String -> Label -> Label -> Integer -> Integer -> Integer -> Test -eqTest name expected mkPreLabel mkPostLabel width todo done = - testCase name $ assertEqual errMsg expected actual +labelTest :: String -> Label -> Progress -> String -> Test +labelTest testName label progress expected = + testCase testName $ assertEqual expectationError expected (label progress) + +eqTest :: String -> String -> Label -> Label -> Integer -> Progress -> Test +eqTest name expected mkPreLabel mkPostLabel width progress = + testCase name $ assertEqual expectationError expected actual where - actual = mkProgressBar mkPreLabel mkPostLabel width todo done - errMsg = "Expected result doesn't match actual result" + actual = mkProgressBar mkPreLabel mkPostLabel width progress + +expectationError :: String +expectationError = "Expected result doesn't match actual result"