arbtt 0.11.1 → 0.12
raw patch · 16 files changed
+155/−133 lines, 16 filesdep +tzdep −old-localedep ~aesondep ~attoparsecdep ~binary
Dependencies added: tz
Dependencies removed: old-locale
Dependency ranges changed: aeson, attoparsec, binary, tasty-golden, time
Files
- README.md +4/−1
- arbtt.cabal +25/−52
- doc/arbtt.xml +27/−2
- src/Capture/X11.hs +2/−1
- src/Categorize.hs +7/−9
- src/Data.hs +3/−3
- src/Data/Binary/StringRef.hs +6/−2
- src/Data/List/TakeR.hs +6/−5
- src/DumpFormat.hs +3/−7
- src/Stats.hs +8/−11
- src/TimeLog.hs +35/−33
- src/dump-main.hs +20/−4
- src/stats-main.hs +3/−2
- tests/empty.log +1/−0
- tests/empty_dump.out +0/−0
- tests/test.hs +5/−1
README.md view
@@ -70,6 +70,9 @@ The issue tracker is hosted on GitHub: <https://github.com/nomeata/arbtt/issues> +User and Developer discussion happens on the arbtt mailing list, `arbtt@lists.nomeata.de`.+To subscribe to the list, visit <http://lists.nomeata.de/mailman/listinfo/arbtt>.+ 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?
arbtt.cabal view
@@ -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
doc/arbtt.xml view
@@ -1761,6 +1761,10 @@ arbtt is Copyright © 2009-2010 Joachim Breitner </para> + <para>+ You can reach developers and users of arbtt on the arbtt mailing list at <ulink url="mailto:arbtt@lists.nomeata.de">arbtt@lists.nomeata.de</ulink>, which you can subscribe at <ulink url="http://lists.nomeata.de/mailman/listinfo/arbtt">http://lists.nomeata.de/mailman/listinfo/arbtt</ulink>.+ </para>+ <sect2> <title>arbtt License</title> <para>@@ -1789,6 +1793,27 @@ The version history with changes relevant for the user is documented here. </para> + <sect2 id="release-notes-0.12>+ <title>Version 0.12</title>+ <itemizedlist>+ <listitem>+ <para>+ Improved timezone handling+ </para>+ </listitem>+ <listitem>+ <para>+ Empty logfiles no longer crash <command>arbtt-stats</command>, thanks to Tomáš Janoušek+ </para>+ </listitem>+ <listitem>+ <para>+ New option <option>--first</option> for <command>arbtt-dump</command>, thanks to Tomáš Janoušek.+ </para>+ </listitem>+ </itemizedlist>+ </sect2>+ <sect2 id="release-notes-0.11.1"> <title>Version 0.11.1</title> <itemizedlist>@@ -1805,12 +1830,12 @@ <itemizedlist> <listitem> <para>- Support for the <literal>$hidden</literal> and <literal>$wdesktop</literal> variables in the configuration file, thanks to Tomas Janousek.+ Support for the <literal>$hidden</literal> and <literal>$wdesktop</literal> variables in the configuration file, thanks to Tomáš Janoušek. </para> </listitem> <listitem> <para>- The <option>--filter</option> option of <command>arbtt-stats</command> is greatly sped up, thanks to Tomas Janousek.+ The <option>--filter</option> option of <command>arbtt-stats</command> is greatly sped up, thanks to Tomáš Janoušek. </para> </listitem> </itemizedlist>
src/Capture/X11.hs view
@@ -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
src/Categorize.hs view
@@ -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
src/Data.hs view
@@ -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."
src/Data/Binary/StringRef.hs view
@@ -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
src/Data/List/TakeR.hs view
@@ -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
src/DumpFormat.hs view
@@ -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 ()
src/Stats.hs view
@@ -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
src/TimeLog.hs view
@@ -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
src/dump-main.hs view
@@ -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
src/stats-main.hs view
@@ -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
+ tests/empty.log view
@@ -0,0 +1,1 @@+arbtt-timelog-v1
+ tests/empty_dump.out view
tests/test.hs view
@@ -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