terminal-progress-bar 0.1.1.1 → 0.1.2

raw patch · 6 files changed

+419/−171 lines, 6 filesdep +asyncdep +randomdep +terminal-sizedep ~HUnitdep ~basedep ~stmPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: async, random, terminal-size

Dependency ranges changed: HUnit, base, stm, stm-chans, test-framework, test-framework-hunit

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• example.hs +38/−10
• src/System/ProgressBar.hs +49/−124
• src/System/ProgressBar/State.hs +280/−0
• terminal-progress-bar.cabal +20/−12
• test/test.hs +31/−24

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

@@ -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

@@ -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 })

@@ -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:+-- &#x2200; d t : &#x2115;. d &#x2264; t &#x2192; length (percentage d t) &#x2261; 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:+-- &#x2200; d&#x2081; d&#x2082; t : &#x2115;. d&#x2081; &#x2264; d&#x2082; &#x2264; t &#x2192; length (exact d&#x2081; t) &#x2261; length (exact d&#x2082; 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

@@ -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 <vandijk.roel@gmail.com> maintainer:    Roel van Dijk <vandijk.roel@gmail.com>-copyright:     2012–2014 Roel van Dijk <vandijk.roel@gmail.com>+copyright:     2012–2018 Roel van Dijk <vandijk.roel@gmail.com> 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

@@ -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"