Allow time diff values > 99:00
[darcs-mirror-arbtt.git] / tests / test.hs
1 {-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}
2
3 import Test.Tasty hiding (defaultMain)
4 import Test.Tasty.Golden.Manage
5 import Test.Tasty.Golden
6 import Test.Tasty.HUnit
7 import Test.HUnit
8 import System.Process.ByteString.Lazy
9 import qualified Data.ByteString.Lazy as B
10 import Control.Monad
11 import Control.Exception
12 import Data.Typeable
13 import System.Exit
14 import System.Posix.Env
15
16 import Categorize
17 import TimeLog
18 import Data
19 import Data.Time.Clock
20
21 main = do
22     putEnv "TZ=UTC" -- to make tests reproducible
23     defaultMain tests
24
25 tests :: TestTree
26 tests = testGroup "Tests" [goldenTests, regressionTests]
27
28 regressionTests :: TestTree
29 regressionTests = testGroup "Regression tests"
30     [ testCase "Issue #4" $ do
31         cat <- readCategorizer "tests/issue4.cfg"
32         let sample = TimeLogEntry undefined 0 (CaptureData [(True, "aa", "program")] 0 "")
33         let [TimeLogEntry _ _ (_,acts)] = cat [sample]
34         [Activity (Just "Cat") "aa"] @=? acts
35         return ()
36     , testCase "Issue #5" $ do
37         cat <- readCategorizer "tests/issue5.cfg"
38         let sample = TimeLogEntry undefined 0 (CaptureData [(True, "aa", "program")] 0 "")
39         let [TimeLogEntry _ _ (_,acts)] = cat [sample]
40         [Activity Nothing "A2"] @=? acts
41         return ()
42     , testCase "Issue #14" $ do
43         cat <- readCategorizer "tests/issue14.cfg"
44         now <- getCurrentTime
45         let backThen = (-60*60*101) `addUTCTime` now
46
47         let sample = TimeLogEntry backThen 0 (CaptureData [(True, "aa", "program")] 0 "")
48         let [TimeLogEntry _ _ (_,acts)] = cat [sample]
49         [Activity Nothing "old"] @=? acts
50         return ()
51     ]
52
53
54 goldenTests :: TestTree
55 goldenTests = testGroup "Golden tests"
56     [ goldenVsString "dump small"
57         "tests/small_dump.out" $
58         run "dist/build/arbtt-dump/arbtt-dump" ["-f","tests/small.log", "-t", "Show"] B.empty
59     , goldenVsFile "import small"
60         "tests/small_import.out" "tests/small_import.out.actual" $ void $
61         B.readFile "tests/small_import.in" >>=
62         run "dist/build/arbtt-import/arbtt-import" ["-f","tests/small_import.out.actual"]
63     , goldenVsFile "recover small"
64         "tests/small_borked_recover.out" "tests/small_borked_recover.out.actual" $ void $
65         run "dist/build/arbtt-recover/arbtt-recover" ["-i","tests/small_borked_recover.out", "-o", "tests/small_borked_recover.out.actual"] B.empty
66     , goldenVsString "stats small"
67         "tests/small_stats.out" $
68         run "dist/build/arbtt-stats/arbtt-stats" ["--logfile", "tests/small.log", "--categorize", "tests/small.cfg"] B.empty
69     , goldenVsString "stats small csv"
70         "tests/small_stats_csv.out" $
71         run "dist/build/arbtt-stats/arbtt-stats" ["--logfile", "tests/small.log", "--categorize", "tests/small.cfg", "--output-format", "csv"] B.empty
72     , goldenVsString "stats small unicode"
73         "tests/unicode_stats.out" $
74         run "dist/build/arbtt-stats/arbtt-stats" ["--logfile", "tests/unicode.log", "--categorize", "tests/unicode.cfg"] B.empty
75     ]
76
77
78 run :: FilePath -> [FilePath] -> B.ByteString -> IO B.ByteString
79 run cmd args stdin = do
80    (ex,stdout,stderr) <- readProcessWithExitCode cmd args stdin
81    unless (B.null stderr) $ throwIO $ StderrException stderr
82    case ex of
83      ExitSuccess   -> return stdout
84      ExitFailure r -> throwIO $ ExitCodeException r
85
86 data StderrException = StderrException B.ByteString
87      deriving (Show, Typeable)
88 data ExitCodeException = ExitCodeException Int
89      deriving (Show, Typeable)
90
91 instance Exception StderrException
92 instance Exception ExitCodeException