diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -70,6 +70,9 @@ The issue tracker is hosted on GitHub: +User and Developer discussion happens on the arbtt mailing list, `arbtt@lists.nomeata.de`. +To subscribe to the list, visit . + Some of my plans or ideas include: * A graphical viewer that allows you to expore the tags in an appealing, @@ -83,7 +86,7 @@ at night. (Partially done) * Storing the current timezone in the tags, for the prevoius entry to be more to be more useful. - * Storing the hostname, in case a user has several. + * Storing the hostname, in case a user has several. * Statistics based on time, to visualize trends. * Possibly more data sources? diff --git a/arbtt.cabal b/arbtt.cabal --- a/arbtt.cabal +++ b/arbtt.cabal @@ -1,5 +1,5 @@ name: arbtt -version: 0.11.1 +version: 0.12 license: GPL-2 license-file: LICENSE category: Desktop @@ -29,13 +29,6 @@ setup.iss, modpath.iss, tests/*.log, tests/*.out, tests/*.in, tests/*.cfg -flag old-locale - description: - If false then depend on time >= 1.5. - . - If true then depend on time < 1.5 together with old-locale. - default: False - executable arbtt-capture main-is: capture-main.hs hs-source-dirs: src @@ -43,14 +36,10 @@ base >= 4.7 && < 5, filepath, directory, transformers, utf8-string, strict, containers >= 0.5 && < 0.7, - aeson >= 0.10 && < 1.6, - binary >= 0.5, - bytestring, deepseq - - if flag(old-locale) - build-depends: time == 1.4.*, old-locale - else - build-depends: time >= 1.5 + aeson >= 0.10 && < 2.1, + binary >= 0.6.4, + bytestring, deepseq, + time >= 1.5, tz other-modules: Data @@ -104,24 +93,20 @@ parsec == 3.*, containers >= 0.5 && < 0.7, pcre-light, - binary >= 0.5, + binary >= 0.6.4, deepseq, bytestring, utf8-string, strict, transformers, directory, filepath, - aeson >= 0.10 && < 1.6, + aeson >= 0.10 && < 2.1, array == 0.4.* || == 0.5.*, terminal-progress-bar >= 0.4 && < 0.5, bytestring-progress, mtl, - text + text, + time >= 1.5, tz if !os(windows) build-depends: unix - if flag(old-locale) - build-depends: time == 1.4.*, old-locale - else - build-depends: time >= 1.5 - other-modules: Data Data.MyText @@ -152,19 +137,15 @@ base >= 4.7 && < 5, parsec == 3.*, containers >= 0.5 && < 0.7, - aeson >= 0.10 && < 1.6, - array == 0.4.* || == 0.5.*, - binary >= 0.5, + aeson >= 0.10 && < 2.1, + binary >= 0.6.4, deepseq, bytestring, utf8-string, strict, - transformers, directory, filepath + transformers, directory, filepath, + time >= 1.5, tz if !os(windows) build-depends: unix - if flag(old-locale) - build-depends: time == 1.4.*, old-locale - else - build-depends: time >= 1.5 other-modules: Data @@ -190,21 +171,18 @@ base >= 4.7 && < 5, parsec == 3.*, containers >= 0.5 && < 0.7, - binary >= 0.5, - aeson >= 0.10 && < 1.6, + binary >= 0.6.4, + aeson >= 0.10 && < 2.1, conduit >= 1.2 && < 1.4, exceptions >= 0.8, - attoparsec == 0.13.*, + attoparsec >= 0.13, deepseq, bytestring, utf8-string, strict, - transformers, directory, filepath + transformers, directory, filepath, + time >= 1.5, tz if !os(windows) build-depends: unix - if flag(old-locale) - build-depends: time == 1.4.*, old-locale - else - build-depends: time >= 1.5 other-modules: Data @@ -243,17 +221,14 @@ build-depends: base >= 4.7 && < 5, containers >= 0.5 && < 0.7, - binary >= 0.5, + binary >= 0.6.4, deepseq, bytestring, utf8-string, - directory, filepath + directory, filepath, + time >= 1.5, tz if !os(windows) build-depends: unix - if flag(old-locale) - build-depends: time == 1.4.*, old-locale - else - build-depends: time >= 1.5 other-modules: Data @@ -289,11 +264,11 @@ Build-depends: base >= 4.7 && < 5 , tasty >= 0.7 && < 1.5 - , tasty-golden >= 2.2.0.2 && <= 2.3.4 + , tasty-golden >= 2.2.0.2 && < 2.4 , tasty-hunit >= 0.2 && < 0.11 , process-extras >= 0.2 && < 0.8 , deepseq - , binary >= 0.5 + , binary >= 0.6.4 , bytestring , utf8-string , directory @@ -302,14 +277,12 @@ , pcre-light , transformers , mtl + , time >= 1.5 + , tz if !os(windows) build-depends: unix - if flag(old-locale) - build-depends: time == 1.4.*, old-locale - else - build-depends: time >= 1.5 default-language: Haskell98 build-tool-depends: arbtt:arbtt-stats diff --git a/doc/arbtt.xml b/doc/arbtt.xml --- a/doc/arbtt.xml +++ b/doc/arbtt.xml @@ -1761,6 +1761,10 @@ arbtt is Copyright © 2009-2010 Joachim Breitner + + You can reach developers and users of arbtt on the arbtt mailing list at arbtt@lists.nomeata.de, which you can subscribe at http://lists.nomeata.de/mailman/listinfo/arbtt. + + arbtt License @@ -1789,6 +1793,27 @@ The version history with changes relevant for the user is documented here. + Version 0.11.1 @@ -1805,12 +1830,12 @@ - Support for the $hidden and $wdesktop variables in the configuration file, thanks to Tomas Janousek. + Support for the $hidden and $wdesktop variables in the configuration file, thanks to Tomáš Janoušek. - The option of arbtt-stats is greatly sped up, thanks to Tomas Janousek. + The option of arbtt-stats is greatly sped up, thanks to Tomáš Janoušek. diff --git a/src/Capture/X11.hs b/src/Capture/X11.hs --- a/src/Capture/X11.hs +++ b/src/Capture/X11.hs @@ -123,9 +123,10 @@ where -- _NET_DESKTOP_NAMES is a list of NULL-terminated strings but -- wcTextPropertyToTextList treats NULL as a separator, - -- so we need to drop the final empty string + -- so we need to drop the final empty string (if there is one) dropTailNull [""] = [] dropTailNull (x:xs) = x : dropTailNull xs + dropTailNull [] = [] getDesktop :: String -> Display -> Window -> IO (Maybe Int) getDesktop prop dpy w = flip catchIOError (\_ -> return Nothing) $ do diff --git a/src/Categorize.hs b/src/Categorize.hs --- a/src/Categorize.hs +++ b/src/Categorize.hs @@ -32,11 +32,8 @@ import Text.Parsec import Text.Parsec.ExprFail import Text.Parsec.Token -#if MIN_VERSION_time(1,5,0) import Data.Time.Format(defaultTimeLocale, iso8601DateFormat) -#else -import System.Locale (defaultTimeLocale, iso8601DateFormat) -#endif +import Data.Time.Zones import Debug.Trace import Text.Printf import GHC.Generics (Generic) @@ -46,7 +43,7 @@ type Rule = Ctx -> ActivityData type Environment = Map String Cond -type Parser = ParsecT String () (ReaderT (TimeZone, Environment) Identity) +type Parser = ParsecT String () (ReaderT (TZ, Environment) Identity) data Ctx = Ctx { cNow :: TimeLogEntry CaptureData @@ -92,8 +89,9 @@ readCategorizer filename = withFile filename ReadMode $ \h -> do hSetEncoding h utf8 content <- hGetContents h + tz <- loadLocalTZ time <- getZonedTime - case runParserStack (zonedTimeZone time, Map.empty) (between (return ()) eof parseRules) filename content of + case runParserStack (tz, Map.empty) (between (return ()) eof parseRules) filename content of Left err -> do putStrLn "Parser error:" print err @@ -103,7 +101,7 @@ mkApplyCond :: String -> IO ApplyCond mkApplyCond s = do - tz <- getCurrentTimeZone + tz <- loadLocalTZ case runParserStack (tz, Map.empty) (parseCond <* eof) "command line parameter" s of Left err -> do putStrLn "Parser error:" @@ -122,7 +120,7 @@ where go (Activity (Just c1) _) (Activity (Just c2) _) = c1 == c2 go a1 a2 = a1 == a2 -lang :: GenTokenParser String () (ReaderT (TimeZone, Environment) Identity) +lang :: GenTokenParser String () (ReaderT (TZ, Environment) Identity) lang = makeTokenParser LanguageDef { commentStart = "{-" , commentEnd = "-}" @@ -464,7 +462,7 @@ day <- read <$> count 2 digit time <- option 0 parseTime let date = LocalTime (fromGregorian year month day) (TimeOfDay 0 0 0) - return $ addUTCTime time $ localTimeToUTC tz date + return $ addUTCTime time $ localTimeToUTCTZ tz date parseSetTag :: Parser Rule diff --git a/src/Data.hs b/src/Data.hs --- a/src/Data.hs +++ b/src/Data.hs @@ -93,7 +93,7 @@ v <- getWord8 case v of 1 -> TimeLogEntry <$> get <*> get <*> ls_get strs - _ -> error $ "Unsupported TimeLogEntry version tag " ++ show v ++ "\n" ++ + _ -> fail $ "Unsupported TimeLogEntry version tag " ++ show v ++ "\n" ++ "You can try to recover your data using arbtt-recover." instance Binary UTCTime where @@ -131,7 +131,7 @@ 2 -> CaptureData <$> (map fromWDv0 . fromIntLenW <$> ls_get strs) <*> ls_get strs <*> pure "" 3 -> CaptureData <$> (map fromWDv0 . fromIntLenW <$> ls_get strs) <*> ls_get strs <*> (fromIntLen <$> ls_get strs) 4 -> CaptureData <$> ls_get strs <*> ls_get strs <*> ls_get strs - _ -> error $ "Unsupported CaptureData version tag " ++ show v ++ "\n" ++ + _ -> fail $ "Unsupported CaptureData version tag " ++ show v ++ "\n" ++ "You can try to recover your data using arbtt-recover." fromIntLenW :: IntLen [(Bool, IntLen Text, IntLen Text)] -> [(Bool, Text, Text)] @@ -164,5 +164,5 @@ wProgram <- ls_get strs wDesktop <- ls_get strs return WindowData{..} - _ -> error $ "Unsupported WindowData version tag " ++ show v ++ "\n" ++ + _ -> fail $ "Unsupported WindowData version tag " ++ show v ++ "\n" ++ "You can try to recover your data using arbtt-recover." diff --git a/src/Data/Binary/StringRef.hs b/src/Data/Binary/StringRef.hs --- a/src/Data/Binary/StringRef.hs +++ b/src/Data/Binary/StringRef.hs @@ -70,7 +70,9 @@ _ -> putWord8 0 >> ls_put strs (T.unpack s) ls_get strs = getWord8 >>= \case 0 -> T.pack <$> ls_get strs - i -> return $! strs !! fromIntegral (pred i) + i -> case drop (fromIntegral (pred i)) strs of + [] -> fail "invalid string reference" + s : _ -> return s -- | 'ls_get strsMany n' ls_get strs 'n' elements in order, without blowing the stack. ls_getMany :: StringReferencingBinary a => [Text] -> Int -> Get [a] @@ -105,7 +107,9 @@ _ -> putWord8 0 >> ls_put strs (IntLen (T.unpack s)) ls_get strs = fmap IntLen $ getWord8 >>= \case 0 -> T.pack . fromIntLen <$> ls_get strs - i -> return $! strs !! fromIntegral (pred i) + i -> case drop (fromIntegral (pred i)) strs of + [] -> fail "invalid string reference" + s : _ -> return s {- instance Binary a => StringReferencingBinary a where diff --git a/src/Data/List/TakeR.hs b/src/Data/List/TakeR.hs --- a/src/Data/List/TakeR.hs +++ b/src/Data/List/TakeR.hs @@ -1,12 +1,8 @@ {-# LANGUAGE ScopedTypeVariables #-} module Data.List.TakeR where -import Control.Monad.ST -import Debug.Trace -import Data.Array.MArray -import Data.Array.ST - -- Efficient taking of last r values +takeR :: Int -> [a] -> [a] takeR n l = go (drop n l) l where go [] r = r @@ -14,6 +10,11 @@ -- Much faster and better evaluation properties than: {- +import Control.Monad.ST +import Debug.Trace +import Data.Array.MArray +import Data.Array.ST + takeR :: forall a. Int -> [a] -> [a] takeR n l | n <= 0 = [] takeR n l = runST stAction diff --git a/src/DumpFormat.hs b/src/DumpFormat.hs --- a/src/DumpFormat.hs +++ b/src/DumpFormat.hs @@ -11,11 +11,7 @@ import Data.Aeson import qualified Data.ByteString.Lazy as LBS import Data.Time -#if MIN_VERSION_time(1,5,0) -import Data.Time.Format(defaultTimeLocale) -#else -import System.Locale (defaultTimeLocale) -#endif +import Data.Time.Zones import Data.Char import Data.Foldable (toList) import Control.Applicative ((<$>), (<|>), (<*>), pure) @@ -111,9 +107,9 @@ dumpHeader :: UTCTime -> Integer -> IO () dumpHeader time lastActivity = do - tz <- getCurrentTimeZone + tz <- loadLocalTZ printf "%s (%dms inactive):\n" - (formatTime defaultTimeLocale "%F %X" (utcToLocalTime tz time)) + (formatTime defaultTimeLocale "%F %X" (utcToLocalTimeTZ tz time)) lastActivity dumpWindow :: WindowData -> IO () diff --git a/src/Stats.hs b/src/Stats.hs --- a/src/Stats.hs +++ b/src/Stats.hs @@ -26,11 +26,8 @@ import qualified Data.Set as S import Data.MyText (Text,pack,unpack) import Data.Function (on) -#if MIN_VERSION_time(1,5,0) import Data.Time.Format(defaultTimeLocale) -#else -import System.Locale (defaultTimeLocale) -#endif +import Data.Time.Zones import Control.Applicative import Control.Monad (forM) import Data.Strict ((:!:), Pair(..)) @@ -191,12 +188,12 @@ let go' m act = M.insertWith (+) act (fromInteger (tlRate tl)/1000) m in foldl' go' m (snd (tlData tl))) id -processRepeater :: TimeZone -> Repeater -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults +processRepeater :: TZ -> Repeater -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults processRepeater tz r rep = case repeaterImpl r of RepeaterImpl catR showR -> filterElems (\(b :!: _) -> b) $ pure (RepeatedReportResults (repeaterTitle r) . map (first showR) . M.toList) <*> - multiplex (catR . utcToLocalTime tz . tlTime . Strict.snd) rep + multiplex (catR . utcToLocalTimeTZ tz . tlTime . Strict.snd) rep data RepeaterImpl where RepeaterImpl :: Ord r => (LocalTime -> r) -> (r -> String) -> RepeaterImpl @@ -226,7 +223,7 @@ ((\(y,_,_) -> y) . toGregorian . localDay) show -processReport :: TimeZone -> ReportOptions -> Report -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults +processReport :: TZ -> ReportOptions -> Report -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults processReport tz opts GeneralInfos = pure (\n firstDate lastDate ttr tts -> let timeDiff = diffUTCTime lastDate firstDate @@ -329,7 +326,7 @@ tlRateTimediff :: TimeLogEntry a -> NominalDiffTime tlRateTimediff tle = fromIntegral (tlRate tle) / 1000 -processIntervalReport :: TimeZone -> ReportOptions -> String -> (ActivityData -> Maybe String) -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults +processIntervalReport :: TZ -> ReportOptions -> String -> (ActivityData -> Maybe String) -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults processIntervalReport tz opts title extr = runOnIntervals go1 go2 where go1 :: LeftFold (TimeLogEntry (Ctx, ActivityData)) [Interval] @@ -364,7 +361,7 @@ {- -intervalReportToTable :: TimeZone -> String -> (ActivityData -> Maybe String) -> ReportResults +intervalReportToTable :: TZ -> String -> (ActivityData -> Maybe String) -> ReportResults intervalReportToTable tz title extr = ListOfIntervals title $ map (\tles -> let str = fromJust (tlData (head tles)) @@ -479,8 +476,8 @@ mins = (s `div` 60) `mod` 60 secs = s `mod` 60 -showAsLocalTime :: TimeZone -> UTCTime -> String -showAsLocalTime tz = formatTime defaultTimeLocale "%x %X" . utcToZonedTime tz +showAsLocalTime :: TZ -> UTCTime -> String +showAsLocalTime tz = formatTime defaultTimeLocale "%x %X" . utcToLocalTimeTZ tz underline :: String -> String underline str = unlines diff --git a/src/TimeLog.hs b/src/TimeLog.hs --- a/src/TimeLog.hs +++ b/src/TimeLog.hs @@ -15,8 +15,6 @@ import Data.Function import Data.Char import System.Directory -import Control.Exception -import Prelude hiding (catch) import Control.DeepSeq #ifndef mingw32_HOST_OS import System.Posix.Files @@ -49,7 +47,7 @@ threadDelay (fromIntegral delay * 1000) loop (Just entry) - + createTimeLog :: Bool -> FilePath -> IO () createTimeLog force filename = do ex <- doesFileExist filename @@ -72,13 +70,18 @@ recoverTimeLog filename = do content <- BS.readFile filename start content - where start content = do - let (startString, rest, off) = runGetState (getLazyByteString (BS.length magic)) content 0 - if startString /= magic - then do putStrLn $ "WARNING: Timelog starts with unknown marker " ++ - show (map (chr.fromIntegral) (BS.unpack startString)) - else do putStrLn $ "Found header, continuing... (" ++ show (BS.length rest) ++ " bytes to go)" - go Nothing rest off + where start content = case runGetOrFail (getLazyByteString (BS.length magic)) content of + Right (rest, off, startString) + | startString /= magic -> do + putStrLn $ "WARNING: Timelog starts with unknown marker " ++ + show (map (chr.fromIntegral) (BS.unpack startString)) + go Nothing rest off + | otherwise -> do + putStrLn $ "Found header, continuing... (" ++ show (BS.length rest) ++ " bytes to go)" + go Nothing rest off + Left _ -> do + putStrLn $ "WARNING: Timelog file shorter than a header marker" + return [] go prev input off = do mb <- trySkip prev input off off @@ -96,22 +99,18 @@ putStrLn "No valid TimeLogEntry tag bytes remaining" return Nothing - tryGet prev input off orig_off = catch ( - do -- putStrLn $ "Trying value at offset " ++ show off - let (v,rest,off') = runGetState (ls_get strs) input off - evaluate rest - when (off /= orig_off) $ - putStrLn $ "Skipped from " ++ show orig_off ++ ", succesful read at position " ++ show off ++ ", lost " ++ show (off - orig_off) ++ " bytes." - return (Just (v,rest,off')) - ) ( - \e -> do - putStrLn $ "Failed to read value at position " ++ show off ++ ":" - putStrLn $ " " ++ show (e :: SomeException) - if BS.length input <= 1 - then do putStrLn $ "End of file reached" - return Nothing - else do trySkip prev (BS.tail input) (off+1) orig_off - ) + tryGet prev input off orig_off = case runGetOrFail (ls_get strs) input of + Right (rest, off', v) -> do + when (off /= orig_off) $ + putStrLn $ "Skipped from " ++ show orig_off ++ ", succesful read at position " ++ show off ++ ", lost " ++ show (off - orig_off) ++ " bytes." + return (Just (v, rest, off + off')) + Left (_, _, e) -> do + putStrLn $ "Failed to read value at position " ++ show off ++ ":" + putStrLn $ " " ++ e + if BS.length input <= 1 + then do putStrLn $ "End of file reached" + return Nothing + else do trySkip prev (BS.tail input) (off+1) orig_off where strs = maybe [] listOfStrings prev readTimeLog :: (NFData a, ListOfStringable a) => FilePath -> IO (TimeLog a) @@ -127,12 +126,15 @@ "Timelog starts with unknown marker " ++ show (map (chr.fromIntegral) (BS.unpack startString)) where - (startString, rest, off) = runGetState (getLazyByteString (BS.length magic)) input 0 - go prev input off = - let (v, rest, off') = runGetState (ls_get strs) input off - in v `deepseq` - if (BS.null rest) - then [v] - else v : go (Just (tlData v)) rest off' + (startString, rest, off) = case runGetOrFail (getLazyByteString (BS.length magic)) input of + Right (rest, off, x) -> (x, rest, off) + Left (_, off, e) -> error $ "Timelog parse error at " ++ show off ++ ": " ++ e + go prev input off + | BS.null input = [] + | otherwise = case runGetOrFail (ls_get strs) input of + Right (rest, off', v) -> + v `deepseq` v : go (Just (tlData v)) rest (off + off') + Left (_, off', e) -> + error $ "Timelog parse error at " ++ show (off + off') ++ ": " ++ e where strs = maybe [] listOfStrings prev diff --git a/src/dump-main.hs b/src/dump-main.hs --- a/src/dump-main.hs +++ b/src/dump-main.hs @@ -23,12 +23,14 @@ data Options = Options { optLogFile :: String , optFormat :: DumpFormat + , optFirst :: Maybe Int , optLast :: Maybe Int } defaultOptions dir = Options { optLogFile = dir "capture.log" , optFormat = DFHuman + , optFirst = Nothing , optLast = Nothing } @@ -62,6 +64,15 @@ hPutStr stderr (usageInfo header options) exitFailure) "FORMAT") "output format, one of Human (default), Show or JSON " + , Option "i" ["first"] + (ReqArg (\arg opt -> + case reads arg of + [(n, "")] | n >= 0 -> return $ opt { optFirst = Just n } + _ -> do + hPutStrLn stderr ("Invalid number \"" ++ arg ++ "\".") + hPutStr stderr (usageInfo header options) + exitFailure) "NUMBER") + "only dump the first NUMBER of samples." , Option "l" ["last"] (ReqArg (\arg opt -> case reads arg of @@ -84,11 +95,16 @@ dir <- getAppUserDataDirectory "arbtt" flags <- foldl (>>=) (return (defaultOptions dir)) actions - + captures <- readTimeLog (optLogFile flags) :: IO (TimeLog CaptureData) - captures <- case optLast flags of - Nothing -> return captures - Just n -> return $ takeR n captures + captures <- case (optFirst flags, optLast flags) of + (Nothing, Nothing) -> return captures + (Just n , Nothing) -> return $ take n captures + (Nothing, Just n ) -> return $ takeR n captures + (Just _ , Just _ ) -> do + hPutStrLn stderr "--first and --last are mutually exclusive" + hPutStr stderr (usageInfo header options) + exitFailure dumpSamples (optFormat flags) captures diff --git a/src/stats-main.hs b/src/stats-main.hs --- a/src/stats-main.hs +++ b/src/stats-main.hs @@ -18,6 +18,7 @@ import TermSize import qualified Data.MyText as T import qualified Data.Text.Lazy as TL +import Data.Time.Zones import Data.Time.LocalTime import TimeLog @@ -166,7 +167,7 @@ (_,_,errs) -> do hPutStr stderr (concat errs ++ usageInfo header options) exitFailure - tz <- getCurrentTimeZone + tz <- loadLocalTZ dir <- getAppUserDataDirectory "arbtt" flags <- foldl (>>=) (return (defaultOptions dir)) actions @@ -189,7 +190,7 @@ let pbStyle = defStyle { stylePrefix = msg (TL.pack "Processing data") , stylePostfix = percentage } pb <- hNewProgressBar stderr pbStyle 10 (Progress 0 100 ()) - trackProgressWithChunkSize (fromIntegral size `div` 100) + trackProgressWithChunkSize (1 `max` (fromIntegral size `div` 100)) (\_ b -> updateProgress pb (const (Progress (fromIntegral b) (fromIntegral size) ()))) timelog False -> return timelog diff --git a/tests/empty.log b/tests/empty.log new file mode 100644 --- /dev/null +++ b/tests/empty.log @@ -0,0 +1,1 @@ +arbtt-timelog-v1 diff --git a/tests/empty_dump.out b/tests/empty_dump.out new file mode 100644 --- /dev/null +++ b/tests/empty_dump.out diff --git a/tests/test.hs b/tests/test.hs --- a/tests/test.hs +++ b/tests/test.hs @@ -25,6 +25,7 @@ import TimeLog import Data import Data.Time.Clock +import Data.Time.Zones main = do setEnv "TZ" "UTC" -- to make tests reproducible @@ -117,10 +118,13 @@ , goldenVsString "stats small_v4 ($hidden, $wdesktop)" "tests/small_v4_stats.out" $ run "arbtt-stats" ["--logfile", "tests/small_v4.log", "--categorize", "tests/small_v4.cfg"] B.empty + , goldenVsString "dump empty" + "tests/empty_dump.out" $ + run "arbtt-dump" ["-f","tests/empty.log", "-t", "Show"] B.empty ] testParser env parser input = do - tz <- getCurrentTimeZone + tz <- loadLocalTZ return . runIdentity . flip runReaderT (tz, env) . runParserT parser () "" $ input parserTests :: TestTree