1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
{-# language OverloadedStrings #-}
{-# language PackageImports #-}
module Main where
--------------------------------------------------------------------------------
-- Imports
--------------------------------------------------------------------------------
import "base" System.Environment ( getArgs )
import "base" Data.Semigroup ( (<>) )
import "base" Data.Fixed (Pico)
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
import qualified "text" Data.Text.Lazy as TL
import "time" Data.Time (UTCTime(..), NominalDiffTime, formatTime, defaultTimeLocale, addUTCTime, secondsToNominalDiffTime)
--------------------------------------------------------------------------------
-- Test suite
--------------------------------------------------------------------------------
main :: IO ()
main = do opts <- interpretArgsOrExit =<< getArgs
defaultMainWithOpts tests opts
tests :: [Test]
tests =
[ testGroup "Label padding"
[ eqTest "no labels" "[]" mempty mempty 0 $ Progress 0 0 ()
, eqTest "pre" "pre []" (msg "pre") mempty 0 $ Progress 0 0 ()
, eqTest "post" "[] post" mempty (msg "post") 0 $ Progress 0 0 ()
, eqTest "pre & post" "pre [] post" (msg "pre") (msg "post") 0 $ Progress 0 0 ()
]
, testGroup "Bar fill"
[ eqTest "empty" "[....]" mempty mempty 6 $ Progress 0 1 ()
, eqTest "almost half" "[=>..]" mempty mempty 6 $ Progress 49 100 ()
, eqTest "half" "[==>.]" mempty mempty 6 $ Progress 1 2 ()
, eqTest "almost full" "[===>]" mempty mempty 6 $ Progress 99 100 ()
, eqTest "full" "[====]" mempty mempty 6 $ Progress 1 1 ()
, eqTest "overfull" "[====]" mempty mempty 6 $ Progress 2 1 ()
]
, testGroup "Labels"
[ testGroup "Percentage"
[ eqTest " 0%" " 0% [....]" percentage mempty 11 $ Progress 0 1 ()
, eqTest "100%" "100% [====]" percentage mempty 11 $ Progress 1 1 ()
, eqTest " 50%" " 50% [==>.]" percentage mempty 11 $ Progress 1 2 ()
, eqTest "200%" "200% [====]" percentage mempty 11 $ Progress 2 1 ()
, labelTest "0 work todo" percentage (Progress 10 0 ()) "100%"
]
, testGroup "Exact"
[ eqTest "0/0" "0/0 [....]" exact mempty 10 $ Progress 0 0 ()
, eqTest "1/1" "1/1 [====]" exact mempty 10 $ Progress 1 1 ()
, eqTest "1/2" "1/2 [==>.]" exact mempty 10 $ Progress 1 2 ()
, eqTest "2/1" "2/1 [====]" exact mempty 10 $ Progress 2 1 ()
, labelTest "0 work todo" exact (Progress 10 0 ()) "10/0"
]
, testGroup "Label Semigroup"
[ eqTest "exact <> msg <> percentage"
"1/2 - 50% [===>...]"
(exact <> msg " - " <> percentage)
mempty 20 $ Progress 1 2 ()
]
, testGroup "renderDuration"
[ renderDurationTest 42 "42"
, renderDurationTest (5 * 60 + 42) "05:42"
, renderDurationTest (8 * 60 * 60 + 5 * 60 + 42) "08:05:42"
, renderDurationTest (123 * 60 * 60 + 59 * 60 + 59) "123:59:59"
]
, testGroup "remainingTime"
[ labelTestWithTiming "No progress after no time" remainingTimeLabel (Progress 0 100 ()) (elapsedSecsTiming 0) "Estimating"
, labelTestWithTiming "No progress after some time" remainingTimeLabel (Progress 0 100 ()) (elapsedSecsTiming 10) "Estimating"
, labelTestWithTiming "Some progress after no time" remainingTimeLabel (Progress 50 100 ()) (elapsedSecsTiming 0) "Estimating"
, labelTestWithTiming "Some progress after some time" remainingTimeLabel (Progress 50 100 ()) (elapsedSecsTiming 10) "10"
, labelTestWithTiming "No work to be done after no time" remainingTimeLabel (Progress 0 0 ()) (elapsedSecsTiming 0) "Estimating"
, labelTestWithTiming "No work to be done after some time" remainingTimeLabel (Progress 0 0 ()) (elapsedSecsTiming 10) "Estimating"
, labelTestWithTiming "More progress than work to be done after no time" remainingTimeLabel (Progress 50 0 ()) (elapsedSecsTiming 0) "Estimating"
, labelTestWithTiming "More progress than work to be done after some time" remainingTimeLabel (Progress 50 0 ()) (elapsedSecsTiming 10) "0"
]
]
]
labelTest :: String -> Label () -> Progress () -> TL.Text -> Test
labelTest testName label progress expected =
testCase testName $ assertEqual expectationError expected $ runLabel label progress someTiming
labelTestWithTiming :: String -> Label () -> Progress () -> Timing -> TL.Text -> Test
labelTestWithTiming testName label progress timing expected =
testCase testName $ assertEqual expectationError expected $ runLabel label progress timing
renderDurationTest :: NominalDiffTime -> TL.Text -> Test
renderDurationTest dt expected =
testCase ("renderDuration " <> show dt) $ assertEqual expectationError expected $ renderDuration dt
eqTest :: String -> TL.Text -> Label () -> Label () -> Int -> Progress () -> Test
eqTest name expected mkPreLabel mkPostLabel width progress =
testCase name $ assertEqual expectationError expected actual
where
actual = renderProgressBar style progress someTiming
style :: Style ()
style = defStyle
{ stylePrefix = mkPreLabel
, stylePostfix = mkPostLabel
, styleWidth = ConstantWidth width
}
someTime :: UTCTime
someTime = UTCTime (toEnum 0) 0
someTiming :: Timing
someTiming = Timing someTime someTime
elapsedSecsTiming :: Pico -> Timing
elapsedSecsTiming seconds = Timing someTime (addUTCTime (secondsToNominalDiffTime seconds) someTime)
expectationError :: String
expectationError = "Expected result doesn't match actual result"
remainingTimeLabel :: Label ()
remainingTimeLabel = remainingTime (TL.pack . formatTime defaultTimeLocale "%s") "Estimating"
|
