Added test suite

roelvandijk · Jan 30, 2012 · 764c6b4 · 764c6b4
1 parent 304fa87
commit 764c6b4
Show file tree

Hide file tree

Showing 3 changed files with 102 additions and 10 deletions.
diff --git a/src/System/ProgressBar.hs b/src/System/ProgressBar.hs
@@ -7,24 +7,23 @@ module System.ProgressBar
       -- * Labels
     , Label
     , noLabel
+    , msg
     , percentage
     , exact
     ) where
 
-import "base" Control.Monad ( when )
 import "base" Data.Bool     ( otherwise )
 import "base" Data.Function ( ($) )
-import "base" Data.Int      ( Int )
 import "base" Data.List     ( (++), null, genericLength, genericReplicate )
 import "base" Data.Ord      ( min, max )
 import "base" Data.Ratio    ( (%) )
 import "base" Data.String   ( String )
-import "base" Prelude       ( (-), round )
+import "base" Prelude       ( (+), (-), round )
 import "base" System.IO     ( IO, putStr, putChar )
 import "base" Text.Printf   ( printf )
 import "base" Text.Show     ( show )
 import "base-unicode-symbols" Data.Eq.Unicode ( (≢) )
-import "base-unicode-symbols" Prelude.Unicode ( ℤ, ℚ, (⋅) )
+import "base-unicode-symbols" Prelude.Unicode ( ℤ, (⋅) )
 
 
 -- | Print a progress bar
@@ -51,22 +50,30 @@ mkProgressBar ∷ Label
 mkProgressBar mkPreLabel mkPostLabel width todo done =
     printf "%s%s[%s%s]%s%s"
            preLabel
-           (pad preLabel)
+           prePad
            (genericReplicate completed '=')
            (genericReplicate remaining '.')
-           (pad postLabel)
+           postPad
            postLabel
   where
-    fraction = todo % done
+    fraction | done ≢ 0  = todo % done
+             | otherwise = 0 % 1
 
-    effectiveWidth = max 0 $ width - 2 - genericLength preLabel - genericLength postLabel
+    effectiveWidth = max 0 $ width - usedSpace
+    usedSpace = 2 + genericLength preLabel
+                  + genericLength postLabel
+                  + genericLength prePad
+                  + genericLength postPad
 
     completed = min effectiveWidth $ round $ fraction ⋅ (effectiveWidth % 1)
     remaining = effectiveWidth - completed
 
     preLabel  = mkPreLabel  todo done
     postLabel = mkPostLabel todo done
 
+    prePad = pad preLabel
+    postPad = pad postLabel
+
     pad ∷ String → String
     pad s | null s    = ""
           | otherwise = " "
@@ -75,10 +82,14 @@ mkProgressBar mkPreLabel mkPostLabel width todo done =
 type Label = ℤ → ℤ → String
 
 noLabel ∷ Label
-noLabel _ _ = ""
+noLabel = msg ""
+
+msg ∷ String → Label
+msg s _ _ = s
 
 percentage ∷ Label
 percentage done todo = printf "%3i%%" (round (done % todo ⋅ 100) ∷ ℤ)
 
 exact ∷ Label
 exact done todo = show done ++ "/" ++ show todo
+
diff --git a/terminal-progress-bar.cabal b/terminal-progress-bar.cabal
@@ -1,6 +1,6 @@
 name:          terminal-progress-bar
 version:       0.0.1
-cabal-version: >=1.6
+cabal-version: >=1.8
 build-type:    Simple
 stability:     provisional
 author:        Roel van Dijk <vandijk.roel@gmail.com>
@@ -25,4 +25,17 @@ library
     build-depends: base                 >= 3.0.3.1 && < 4.6
                  , base-unicode-symbols >= 0.2.2.3 && < 0.3
     exposed-modules: System.ProgressBar
+    ghc-options: -Wall
+
+test-suite test-terminal-progress-bar
+  type: exitcode-stdio-1.0
+  main-is: test.hs
+  hs-source-dirs: src, test
+  ghc-options: -Wall
+  build-depends: base                  >= 3.0.3.1 && < 4.6
+               , base-unicode-symbols  >= 0.2.2.3 && < 0.3
+               , HUnit                 >= 1.2.4.2 && < 1.3
+               , terminal-progress-bar == 0.0.1
+               , test-framework        >= 0.3.3   && < 0.5
+               , test-framework-hunit  >= 0.2.6   && < 0.3
 
diff --git a/test/test.hs b/test/test.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE NoImplicitPrelude, PackageImports, UnicodeSyntax #-}
+
+module Main where
+
+
+--------------------------------------------------------------------------------
+-- Imports
+--------------------------------------------------------------------------------
+
+import "base" Control.Monad      ( (=<<) )
+import "base" Data.Function      ( ($) )
+import "base" Prelude            ( String )
+import "base" System.Environment ( getArgs )
+import "base" System.IO          ( IO )
+import "base-unicode-symbols" Prelude.Unicode ( ℤ )
+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 "this" 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 "full"     "[====]" noLabel noLabel 6 1 1
+    , eqTest "half"     "[==..]" noLabel noLabel 6 1 2
+    , eqTest "overfull" "[====]" noLabel noLabel 6 2 1
+    ]
+  , testGroup "Percentage label"
+    [ 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 label"
+    [ 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 → ℤ → ℤ → ℤ → 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"
+