arbtt 0.5 → 0.6
raw patch · 11 files changed
+420/−233 lines, 11 files
Files
- arbtt.cabal +1/−1
- categorize.cfg +8/−1
- doc/arbtt.xml +89/−14
- src/Categorize.hs +5/−5
- src/Data/MyText.hs +8/−1
- src/Stats.hs +122/−48
- src/capture-main.hs +32/−29
- src/dump-main.hs +23/−21
- src/import-main.hs +25/−24
- src/recover-main.hs +28/−29
- src/stats-main.hs +79/−60
arbtt.cabal view
@@ -1,5 +1,5 @@ name: arbtt-version: 0.5+version: 0.6 license: GPL license-file: LICENSE category: Desktop
categorize.cfg view
@@ -3,7 +3,8 @@ "sun-awt-X11-XFramePeer" -> "java", "sun-awt-X11-XDialogPeer" -> "java", "sun-awt-X11-XWindowPeer" -> "java",- "gramps.py" -> "gramps"+ "gramps.py" -> "gramps",+ "___nforschung" -> "ahnenforschung" ) -- A rule that probably everybody wants. Being inactive for over a minute@@ -27,6 +28,12 @@ ==> tag Project:$1, current window $title =~ m!(?:~|home/jojo)/debian! ==> tag Project:Debian,++-- This was a frequently looked-at pdf-File+current window $title =~ m!output.pdf! &&+any window ($title =~ /nforschung/)+ ==> tag Project:ahnenforschung,+ -- My diploma thesis is in a different directory current window $title =~ m!(?:~|home/jojo)/dokumente/Uni/DA!
doc/arbtt.xml view
@@ -12,26 +12,26 @@ <author> <firstname>Joachim</firstname> <surname>Breitner</surname>- <email>mail@joachim-breitner.de</email> <contrib>Main author of arbtt</contrib>+ <email>mail@joachim-breitner.de</email> </author> <author id="sergey"> <firstname>Sergey</firstname> <surname>Astanin</surname>- <email>s.astanin@gmail.com</email> <contrib>Contributor</contrib>+ <email>s.astanin@gmail.com</email> </author> <author id="martin"> <firstname>Martin</firstname> <surname>Kiefel</surname>- <email>mk@nopw.de</email> <contrib>Contributor</contrib>+ <email>mk@nopw.de</email> </author> <author id="muharem"> <firstname>Muharem</firstname> <surname>Hrnjadovic</surname>- <email>muharem@linux.com</email> <contrib>Contributor</contrib>+ <email>muharem@linux.com</email> </author> </authorgroup> </articleinfo>@@ -41,11 +41,12 @@ has the focus and how long since your last action (and possibly more sources later), and stores this. It is also a program that will, based on expressive rules you specify, derive what you were doing, and what for.- </para> - <warning><para>The log file might contain very sensitive private data. Make sure+ <warning><para>The log file might contain very sensitive private data. Make sure+ you understand the consequences of a full-time logger and be careful with this data.</para></warning>+ </para> </abstract> <sect1 id="installation">@@ -549,7 +550,7 @@ <listitem><simpara>shows the version number, and exists.</simpara></listitem> </varlistentry> <varlistentry>- <term><option>--logfile</option></term>+ <term><option>--logfile</option> <replaceable>FILE</replaceable></term> <listitem><simpara>logfile to use instead of <filename>~/.arbtt/capture.log</filename></simpara></listitem> </varlistentry> <varlistentry>@@ -563,13 +564,15 @@ <term><option>-x</option> <replaceable>TAG</replaceable></term> <term><option>--exclude</option> <replaceable>TAG</replaceable></term> <listitem><simpara>Ignore any data samples that have- been assigned this tag. Can be given more than once.</simpara></listitem>+ been assigned this tag or category. To distinguish tags and categories, the latter have to be+ entered followed by a colon. Can be given more than once.</simpara></listitem> </varlistentry> <varlistentry> <term><option>-o</option> <replaceable>TAG</replaceable></term> <term><option>--only</option> <replaceable>TAB</replaceable></term> <listitem><simpara>Ignore any data samples that have- not been assigned this tag. Can be given more than once.</simpara></listitem>+ not been assigned this tag. To distinguish tags and categories, the latter have to be+ entered followed by a colon. Can be given more than once.</simpara></listitem> </varlistentry> <varlistentry> <term><option>--also-inactive</option></term>@@ -598,6 +601,26 @@ </para></listitem> </varlistentry> <varlistentry>+ <term><option>--output-exclude</option> <replaceable>TAG</replaceable></term>+ <listitem><para>+ Skip this tag or category when printing statistics. Only affects+ the reports <option>--total-time</option> and+ <option>--category</option>. To distinguish tags and categories,+ the latter have to be entered followed by a colon. Can be given+ more than once.+ </para></listitem>+ </varlistentry>+ <varlistentry>+ <term><option>--output-only</option> <replaceable>TAG</replaceable></term>+ <listitem><para>+ Prints statistics only for the specified tag or category. Only+ affects the reports <option>--total-time</option> and+ <option>--category</option>. To distinguish tags and categories,+ the latter have to be entered followed by a colon. Can be given+ more than once.+ </para></listitem>+ </varlistentry>+ <varlistentry> <term><option>--output-format</option> <replaceable>FORMAT</replaceable></term> <listitem><para> Specify the report output format, may be one of: text, csv@@ -624,7 +647,7 @@ <varlistentry> <term><option>-t</option></term> <term><option>--total-time</option></term>- <listitem><para>For all tag, print the part of the selected time+ <listitem><para>For all tags, print the part of the selected time with this tag applied to, both as an absolute value and a percentage of the selected time. </para></listitem>@@ -645,6 +668,24 @@ the data. </para></listitem> </varlistentry>+ <varlistentry>+ <term><option>--intervals</option> [<replaceable>TAG</replaceable>|<replaceable>CATEGORY</replaceable>:] </term>+ <listitem><para>This report lists all periods of consecutive time+ intervals where the given tag has been applied to, or where the+ given category has the same value.+ </para>+ + <para>To distinguish tags and categories, the latter have to be+ entered followed by a colon.</para>+ + <para>This report will give wrong results if an activity has been+ carried out at the end of a session and right at the beginning, as+ the intermediate time is thought to be part of the interval.+ Inactive times while <command>arbtt-capture</command> is running+ will separate the results as expected.</para>+ + </listitem>+ </varlistentry> </variablelist> </refsect2> </refsect1>@@ -730,6 +771,11 @@ <term><option>--rate</option> <replaceable>RATE</replaceable></term> <listitem><simpara>sets the sample rate in seconds (default: 60)</simpara></listitem> </varlistentry>+ <varlistentry>+ <term><option>-f</option> <replaceable>FILE</replaceable></term>+ <term><option>--logfile</option> <replaceable>FILE</replaceable></term>+ <listitem><simpara>logfile to use instead of <filename>~/.arbtt/capture.log</filename></simpara></listitem>+ </varlistentry> </variablelist> </refsect1> <refsect1><title>Files</title>@@ -791,8 +837,8 @@ <listitem><simpara>shows the version number, and exists.</simpara></listitem> </varlistentry> <varlistentry>- <term><option>-f</option></term>- <term><option>--logfile</option></term>+ <term><option>-f</option> <replaceable>FILE</replaceable></term>+ <term><option>--logfile</option> <replaceable>FILE</replaceable></term> <listitem><simpara>logfile to use instead of <filename>~/.arbtt/capture.log</filename></simpara></listitem> </varlistentry> </variablelist>@@ -855,8 +901,8 @@ <listitem><simpara>shows the version number, and exists.</simpara></listitem> </varlistentry> <varlistentry>- <term><option>-f</option></term>- <term><option>--logfile</option></term>+ <term><option>-f</option> <replaceable>FILE</replaceable></term>+ <term><option>--logfile</option> <replaceable>FILE</replaceable></term> <listitem><simpara>logfile to use instead of <filename>~/.arbtt/capture.log</filename></simpara></listitem> </varlistentry> </variablelist>@@ -991,6 +1037,35 @@ <para> The version history with changes relevant for the user are documented here. </para>+ + <sect2>+ <title>Version 0.6</title>+ <itemizedlist>+ <listitem>+ <para>The command <command>arbtt-capture</command> now supports the+ <option>--logfile</option>.+ </para>+ </listitem>+ <listitem>+ <para>New report “intervals”, available using <command>arbtt-stats</command> <option>--intervals</option>.+ </para>+ </listitem>+ <listitem>+ <para>The paramters <option>--exclude</option> and+ <option>--include</option> of <command>arbtt-stats</command> can match+ categories as well as tags.+ </para>+ </listitem>+ <listitem>+ <para>Bugfix: Numbers in tag names are no longer replaced by an underscore.</para>+ </listitem>+ <listitem>+ <para>New paramters <option>--output-exclude</option> and+ <option>--output-include</option> of <command>arbtt-stats</command>.+ </para>+ </listitem>+ </itemizedlist>+ </sect2> <sect2> <title>Version 0.5 (The ZuriHac-Release)</title>
src/Categorize.hs view
@@ -72,11 +72,11 @@ Right cat -> return $ ((fmap . fmap) (mkSecond (postpare . cat)) . prepare time tz) -applyCond :: String -> TimeLog (Ctx, ActivityData) -> TimeLog (Ctx, ActivityData)+applyCond :: String -> TimeLogEntry (Ctx, ActivityData) -> Bool applyCond s = case parse (do {c <- parseCond; eof ; return c}) "commad line parameter" s of Left err -> error (show err)- Right c -> filter (isJust . c . fst . tlData)+ Right c -> isJust . c . fst . tlData prepare :: UTCTime -> TimeZone -> TimeLog CaptureData -> TimeLog Ctx prepare time tz tl = go' [] tl tl@@ -412,16 +412,16 @@ replaceForbidden :: Maybe Text -> Maybe Text replaceForbidden = liftM $ T.map go where- go c | isLetter c = c+ go c | isAlphaNum c = c | c `elem` "-_" = c | otherwise = '_' parseTagPart :: Parser (Ctx -> Maybe Text) parseTagPart = do parts <- many1 (choice [ do char '$'- choice+ (replaceForbidden . ) <$> choice [ do num <- natural lang- return $ replaceForbidden . getBackref num+ return $ getBackref num , do varname <- many1 (letter <|> oneOf ".") return $ getVar varname ] <?> "variable"
src/Data/MyText.hs view
@@ -4,11 +4,18 @@ import qualified Data.ByteString as BS import Data.Binary import Control.Applicative ((<$>))+import Control.Arrow (first) import Prelude hiding (length, map) import qualified Prelude import GHC.Exts( IsString(..) ) -newtype Text = Text { toBytestring :: BSU.ByteString } deriving (Eq, Ord, Show, Read)+newtype Text = Text { toBytestring :: BSU.ByteString } deriving (Eq, Ord)++instance Show Text where+ showsPrec i t = showsPrec i (toBytestring t)++instance Read Text where+ readsPrec i s = Prelude.map (first Text) $ readsPrec i s instance IsString Text where fromString = pack
src/Stats.hs view
@@ -8,48 +8,93 @@ import Text.Printf import qualified Data.Map as M import qualified Data.Set as S-import Data.MyText (Text)+import Data.MyText (Text,pack,unpack)+import Data.Function (on)+import System.Locale (defaultTimeLocale) + import Data import Categorize -data Report = GeneralInfos | TotalTime | Category Text | EachCategory+data Report = GeneralInfos+ | TotalTime+ | Category Category+ | EachCategory+ | IntervalCategory Category+ | IntervalTag Activity deriving (Show, Eq) -data Filter = Exclude Activity | Only Activity | AlsoInactive | GeneralCond String+data Filter = Exclude ActivityMatcher | Only ActivityMatcher | GeneralCond String deriving (Show, Eq) +data ActivityMatcher = MatchActivity Activity | MatchCategory Category+ deriving (Show, Eq)++data ActivityFilter = ExcludeActivity ActivityMatcher | OnlyActivity ActivityMatcher+ deriving (Show, Eq)+ -- Supported report output formats: text, comma-separated values and -- tab-separated values data ReportFormat = RFText | RFCSV | RFTSV deriving (Show, Eq) -data ReportOption = MinPercentage Double | OutputFormat ReportFormat+data ReportOptions = ReportOptions+ { roMinPercentage :: Double+ , roReportFormat :: ReportFormat+ , roActivityFilter :: [ActivityFilter]+ } deriving (Show, Eq) +defaultReportOptions = ReportOptions+ { roMinPercentage = 1+ , roReportFormat = RFText+ , roActivityFilter = []+ }+ -- Data format semantically representing the result of a report, including the -- title data ReportResults = ListOfFields String [(String, String)] | ListOfTimePercValues String [(String, String, Double)] | PieChartOfTimePercValues String [(String, String, Double)]+ | ListOfIntervals String [(String,String,String,String)] -applyFilters :: [Filter] -> TimeLog (Ctx, ActivityData) -> TimeLog (Ctx, ActivityData)-applyFilters filters tle = - foldr (\flag -> case flag of - Exclude act -> excludeTag act- Only act -> onlyTag act- AlsoInactive -> id- GeneralCond s-> applyCond s - ) (if AlsoInactive `elem` filters then tle else defaultFilter tle) filters+-- We apply the filters in a way such that consecutive runs of selected samples+-- are in the same sublist, and sublists are separated by non-selected samples+applyFilters :: [Filter] -> TimeLog (Ctx, ActivityData) -> [TimeLog (Ctx, ActivityData)]+applyFilters filters = filterAndSeparate $ \tl ->+ all (\flag -> case flag of + Exclude act -> excludeTag act tl+ Only act -> onlyTag act tl+ GeneralCond s-> applyCond s tl) filters +applyActivityFilter :: [ActivityFilter] -> Activity -> Bool+applyActivityFilter fs act = all go fs+ where go (ExcludeActivity matcher) = not (matchActivityMatcher matcher act)+ go (OnlyActivity matcher) = matchActivityMatcher matcher act -excludeTag act = filter (notElem act . snd . tlData)-onlyTag act = filter (elem act . snd . tlData)-defaultFilter = excludeTag inactiveActivity+filterAndSeparate :: (a -> Bool) -> [a] -> [[a]]+filterAndSeparate pred = fst . go+ where go [] = ([],True)+ go (x:xs) = case (go xs,pred x) of+ ((rs, True) , True) -> ([x]:rs, False)+ (((r:rs), False), True) -> ((x:r):rs, False)+ ((rs, _) , False) -> (rs, True)+ +excludeTag matcher = not . any (matchActivityMatcher matcher) . snd . tlData+onlyTag matcher = any (matchActivityMatcher matcher) . snd . tlData+defaultFilter = Exclude (MatchActivity inactiveActivity) +matchActivityMatcher :: ActivityMatcher -> Activity -> Bool+matchActivityMatcher (MatchActivity act1) act2 = act1 == act2+matchActivityMatcher (MatchCategory cat) act2 = Just cat == activityCategory act2++parseActivityMatcher :: String -> ActivityMatcher +parseActivityMatcher str | last str == ':' = MatchCategory (pack (init str))+ | otherwise = MatchActivity (read str)+ -- | to be used lazily, to re-use computation when generating more than one -- report at a time data Calculations = Calculations@@ -63,21 +108,22 @@ , fractionSelRec :: Double , sums :: M.Map Activity NominalDiffTime , allTags :: TimeLog (Ctx, ActivityData)- , tags :: TimeLog (Ctx, ActivityData)+ -- tags is a list of uninterrupted entries+ , tags :: [TimeLog (Ctx, ActivityData)] } -prepareCalculations :: TimeLog (Ctx, ActivityData) -> TimeLog (Ctx, ActivityData) -> Calculations+prepareCalculations :: TimeLog (Ctx, ActivityData) -> [TimeLog (Ctx, ActivityData)] -> Calculations prepareCalculations allTags tags = let c = Calculations { firstDate = tlTime (head allTags) , lastDate = tlTime (last allTags) , timeDiff = diffUTCTime (lastDate c) (firstDate c) , totalTimeRec = fromInteger (sum (map tlRate allTags))/1000- , totalTimeSel = fromInteger (sum (map tlRate tags))/1000+ , totalTimeSel = fromInteger (sum (map tlRate (concat tags)))/1000 , fractionRec = realToFrac (totalTimeRec c) / (realToFrac (timeDiff c)) , fractionSel = realToFrac (totalTimeSel c) / (realToFrac (timeDiff c)) , fractionSelRec = realToFrac (totalTimeSel c) / realToFrac (totalTimeRec c)- , sums = sumUp tags+ , sums = sumUp (concat tags) , allTags , tags } in c@@ -95,14 +141,14 @@ where go' (Activity (Just cat) _) = S.insert cat go' _ = id -putReports :: [ReportOption] -> Calculations -> [Report] -> IO ()+putReports :: ReportOptions -> Calculations -> [Report] -> IO () putReports opts c = sequence_ . intersperse (putStrLn "") . map (putReport opts c) -putReport :: [ReportOption] -> Calculations -> Report -> IO ()-putReport opts c EachCategory = putReports opts c (map Category (listCategories (tags c)))+putReport :: ReportOptions -> Calculations -> Report -> IO ()+putReport opts c EachCategory = putReports opts c (map Category (listCategories (concat (tags c)))) putReport opts c r = renderReport opts $ reportToTable opts c r -reportToTable :: [ReportOption] -> Calculations -> Report -> ReportResults+reportToTable :: ReportOptions -> Calculations -> Report -> ReportResults reportToTable opts (Calculations {..}) r = case r of GeneralInfos -> ListOfFields "General Information" $ [ ("FirstRecord", show firstDate)@@ -117,8 +163,9 @@ TotalTime -> ListOfTimePercValues "Total time per tag" $ mapMaybe (\(tag,time) ->- let perc = realToFrac time/realToFrac totalTimeSel in- if perc*100 >= minPercentage+ let perc = realToFrac time/realToFrac totalTimeSel+ pick = applyActivityFilter (roActivityFilter opts) tag+ in if pick && perc*100 >= roMinPercentage opts then Just $ ( show tag , showTimeDiff time , perc)@@ -131,13 +178,14 @@ Category cat -> PieChartOfTimePercValues ("Statistics for category " ++ show cat) $ let filteredSums = M.filterWithKey (\a _ -> isCategory cat a) sums uncategorizedTime = totalTimeSel - M.fold (+) 0 filteredSums- tooSmallSums = M.filter (\t -> realToFrac t / realToFrac totalTimeSel * 100 < minPercentage) filteredSums+ tooSmallSums = M.filter (\t -> realToFrac t / realToFrac totalTimeSel * 100 < roMinPercentage opts) filteredSums tooSmallTimes = M.fold (+) 0 tooSmallSums in mapMaybe (\(tag,time) ->- let perc = realToFrac time/realToFrac totalTimeSel in- if perc*100 >= minPercentage+ let perc = realToFrac time/realToFrac totalTimeSel+ pick = applyActivityFilter (roActivityFilter opts) tag+ in if pick && perc*100 >= roMinPercentage opts then Just ( show tag , showTimeDiff time , perc)@@ -161,35 +209,45 @@ )] else [] )+ + IntervalCategory cat -> intervalReportToTable ("Intervals for category " ++ show cat)+ (extractCat cat) + IntervalTag tag -> intervalReportToTable ("Intervals for category " ++ show tag)+ (extractTag tag) + where- minPercentage = - case pvalues of- [] -> 1- _ -> last pvalues- pvalues = mapMaybe pickPercentage opts- pickPercentage o = case o of- MinPercentage m -> Just m- _ -> Nothing+ extractCat :: Category -> ActivityData -> Maybe String+ extractCat cat = fmap (unpack . activityName) . listToMaybe . filter ( (==Just cat) . activityCategory ) + extractTag :: Activity -> ActivityData -> Maybe String+ extractTag tag = fmap show . listToMaybe . filter ( (==tag) )++ intervalReportToTable :: String -> (ActivityData -> Maybe String) -> ReportResults+ intervalReportToTable title extr = ListOfIntervals title $+ map (\tles ->+ let str = fromJust (tlData (head tles))+ firstE = showUtcTime (tlTime (head tles))+ lastE = showUtcTime (tlTime (last tles))+ timeLength = showTimeDiff $+ tlTime (last tles) `diffUTCTime` tlTime (head tles) ++ fromIntegral (tlRate (last tles))/1000+ in (str, firstE, lastE, timeLength)) $+ filter (isJust . tlData . head ) $+ concat $+ fmap (groupBy ((==) `on` tlData) .+ (fmap.fmap) (extr . snd)) $+ tags+ + + renderReport opts reportdata = do let results = doRender opts reportdata putStr results -doRender opts reportdata = results- where- results =- case outputformat of+doRender opts reportdata = case roReportFormat opts of RFText -> renderReportText reportdata RFCSV -> renderReportCSV reportdata RFTSV -> renderReportTSV reportdata- outputformat =- case formats of- [] -> RFText- _ -> last formats- formats = mapMaybe pickFormats opts- pickFormats o = case o of- OutputFormat f -> Just f- _ -> Nothing renderReportText (ListOfFields title dats) = underline title ++@@ -201,6 +259,9 @@ renderReportText (PieChartOfTimePercValues title dats) = underline title ++ (tabulate True $ piechartOfValues dats) +renderReportText (ListOfIntervals title dats) = + underline title ++ (tabulate True $ listOfIntervals dats)+ listOfValues dats = ["Tag","Time","Percentage"] : map (\(f,t,p) -> [f,t,printf "%.2f" (p*100)]) dats@@ -209,6 +270,10 @@ ["Tag","Time","Percentage"] : map (\(f,t,p) -> [f,t,printf "%.2f" (p*100)]) dats +listOfIntervals dats =+ ["Tag","From","Until","Duration"] :+ map (\(t,f,u,d) -> [t,f,u,d]) dats+ -- The reporting of "General Information" is not supported for the -- comma-separated output format. renderReportCSV (ListOfFields title dats) = @@ -220,6 +285,9 @@ renderReportCSV (PieChartOfTimePercValues _ dats) = renderWithDelimiter "," (piechartOfValues dats) +renderReportCSV (ListOfIntervals title dats) = + renderWithDelimiter "," (listOfIntervals dats)+ -- The reporting of "General Information" is not supported for the -- TAB-separated output format. renderReportTSV (ListOfFields title dats) = @@ -231,6 +299,9 @@ renderReportTSV (PieChartOfTimePercValues _ dats) = renderWithDelimiter "\t" (piechartOfValues dats) +renderReportTSV (ListOfIntervals title dats) = + renderWithDelimiter "\t" (listOfIntervals dats)+ renderWithDelimiter delim datasource = unlines $ map (injectDelimiter delim) datasource @@ -258,6 +329,9 @@ go True ((a,u):vs) = printf "%02d%s" a u ++ go True vs go False ((a,u):vs) | a > 0 = printf "%2d%s" a u ++ go True vs | otherwise = go False vs++showUtcTime :: UTCTime -> String+showUtcTime = formatTime defaultTimeLocale "%x %X" underline str = unlines [ str
src/capture-main.hs view
@@ -26,29 +26,41 @@ import Paths_arbtt (version) -data Conf = Conf {- cSampleRate :: Integer- }-defaultConf = Conf 60+data Options = Options+ { optSampleRate :: Integer+ , optLogFile :: String+ } -data Opts = Help | Version | SetRate Integer- deriving Eq+defaultOptions :: FilePath -> Options+defaultOptions dir = Options+ { optSampleRate = 60+ , optLogFile = dir </> "capture.log"+ } versionStr = "arbtt-capture " ++ showVersion version header = "Usage: arbtt-capture [OPTIONS...]" -options :: [OptDescr Opts]-options = +options :: [OptDescr (Options -> IO Options)]+options = [ Option "h?" ["help"]- (NoArg Help)+ (NoArg $ \_ -> do+ hPutStr stderr (usageInfo header options)+ exitSuccess+ ) "show this help" , Option "V" ["version"]- (NoArg Version)+ (NoArg $ \_ -> do+ hPutStrLn stderr versionStr+ exitSuccess+ ) "show the version number"+ , Option "f" ["logfile"]+ (ReqArg (\arg opt -> return opt { optLogFile = arg }) "FILE")+ "use this file instead of ~/.arbtt/capture.log" , Option "r" ["sample-rate"]- (ReqArg (SetRate . read) "RATE")+ (ReqArg (\arg opt -> return opt { optSampleRate = read arg }) "RATE") "set the sample rate in seconds (default: 60)"- ] + ] -- | This is very raw, someone ought to improve this lockFile filename = do@@ -67,26 +79,17 @@ commonStartup args <- getArgs- flags <- case getOpt Permute options args of- (o, [], []) | Help `notElem` o && Version `notElem` o -> return o- (o, _, _) | Version `elem` o -> do- hPutStrLn stderr versionStr- exitSuccess- (o, _, _) | Help `elem` o -> do- hPutStr stderr (usageInfo header options)- exitSuccess- (_,_,errs) -> do+ actions <- case getOpt Permute options args of+ (o,[],[]) -> return o+ (_,_,errs) -> do hPutStr stderr (concat errs ++ usageInfo header options) exitFailure - let sampleRate = foldr (.) id- (map (\f -> case f of {SetRate r -> const r; _ -> id}) flags)- 60- dir <- getAppUserDataDirectory "arbtt"+ flags <- foldl (>>=) (return (defaultOptions dir)) actions+ createDirectoryIfMissing False dir- let captureFile = dir </> "capture.log"- lockFile captureFile- upgradeLogFile1 captureFile+ lockFile (optLogFile flags)+ upgradeLogFile1 (optLogFile flags) setupCapture- runLogger captureFile (sampleRate * 1000) captureData+ runLogger (optLogFile flags) (optSampleRate flags * 1000) captureData
src/dump-main.hs view
@@ -16,46 +16,48 @@ import Paths_arbtt (version) -data Flag = Help | Version | LogFile String- deriving Eq+data Options = Options+ { optLogFile :: String+ } +defaultOptions dir = Options+ { optLogFile = dir </> "capture.log"+ }++ versionStr = "arbtt-dump " ++ showVersion version header = "Usage: arbtt-dump [OPTIONS...]" -options :: [OptDescr Flag]+options :: [OptDescr (Options -> IO Options)] options = [ Option "h?" ["help"]- (NoArg Help)+ (NoArg $ \_ -> do+ hPutStr stderr (usageInfo header options)+ exitSuccess+ ) "show this help" , Option "V" ["version"]- (NoArg Version)+ (NoArg $ \_ -> do+ hPutStrLn stderr versionStr+ exitSuccess+ ) "show the version number" , Option "f" ["logfile"]- (ReqArg LogFile "FILE")+ (ReqArg (\arg opt -> return opt { optLogFile = arg }) "FILE") "use this file instead of ~/.arbtt/capture.log" ] - main = do commonStartup args <- getArgs- flags <- case getOpt Permute options args of- (o,[],[]) | Help `notElem` o && Version `notElem` o -> return o- (o,_,_) | Version `elem` o -> do- hPutStrLn stderr versionStr- exitSuccess- (o,_,_) | Help `elem` o -> do- hPutStr stderr (usageInfo header options)- exitSuccess+ actions <- case getOpt Permute options args of+ (o,[],[]) -> return o (_,_,errs) -> do hPutStr stderr (concat errs ++ usageInfo header options) exitFailure dir <- getAppUserDataDirectory "arbtt"-- let captureFilename =- fromMaybe (dir </> "capture.log") $ listToMaybe $- mapMaybe (\f -> case f of { LogFile f -> Just f; _ -> Nothing}) $- flags- captures <- readTimeLog captureFilename :: IO (TimeLog CaptureData)+ flags <- foldl (>>=) (return (defaultOptions dir)) actions+ + captures <- readTimeLog (optLogFile flags) :: IO (TimeLog CaptureData) mapM_ print captures
src/import-main.hs view
@@ -17,52 +17,53 @@ import Paths_arbtt (version) -data Flag = Help | Version | LogFile String- deriving Eq+data Options = Options+ { optLogFile :: String+ } +defaultOptions dir = Options+ { optLogFile = dir </> "capture.log"+ }+ versionStr = "arbtt-import " ++ showVersion version header = "Usage: arbtt-import [OPTIONS...]" -options :: [OptDescr Flag]+options :: [OptDescr (Options -> IO Options)] options = [ Option "h?" ["help"]- (NoArg Help)+ (NoArg $ \_ -> do+ hPutStr stderr (usageInfo header options)+ exitSuccess+ ) "show this help" , Option "V" ["version"]- (NoArg Version)+ (NoArg $ \_ -> do+ hPutStrLn stderr versionStr+ exitSuccess+ ) "show the version number" , Option "f" ["logfile"]- (ReqArg LogFile "FILE")+ (ReqArg (\arg opt -> return opt { optLogFile = arg }) "FILE") "use this file instead of ~/.arbtt/capture.log" ] - main = do commonStartup args <- getArgs- flags <- case getOpt Permute options args of- (o,[],[]) | Help `notElem` o && Version `notElem` o -> return o- (o,_,_) | Version `elem` o -> do- hPutStrLn stderr versionStr- exitSuccess- (o,_,_) | Help `elem` o -> do- hPutStr stderr (usageInfo header options)- exitSuccess+ actions <- case getOpt Permute options args of+ (o,[],[]) -> return o (_,_,errs) -> do hPutStr stderr (concat errs ++ usageInfo header options) exitFailure dir <- getAppUserDataDirectory "arbtt"-- let captureFilename =- fromMaybe (dir </> "capture.log") $ listToMaybe $- mapMaybe (\f -> case f of { LogFile f -> Just f; _ -> Nothing}) $- flags- ex <- doesFileExist captureFilename+ flags <- foldl (>>=) (return (defaultOptions dir)) actions+ + ex <- doesFileExist (optLogFile flags) if ex then do- putStrLn $ "File at " ++ captureFilename ++ " does already exist. Please delete this file"- putStrLn $ "before running arbtt-import."+ putStrLn $ "File at " ++ (optLogFile flags) ++ " does already exist. Please delete this"+ putStrLn $ "file before running arbtt-import." else do captures <- map read . lines <$> getContents :: IO (TimeLog CaptureData)- writeTimeLog captureFilename captures+ writeTimeLog (optLogFile flags) captures
src/recover-main.hs view
@@ -16,54 +16,53 @@ import Paths_arbtt (version) -data Flag = Help | Version | InFile String | OutFile String- deriving Eq+data Options = Options+ { optInFile :: String+ , optOutFile :: String+ } +defaultOptions dir = Options+ { optInFile = dir </> "capture.log"+ , optOutFile = dir </> "capture.log.recovered"+ }++ versionStr = "arbtt-recover " ++ showVersion version header = "Usage: arbtt-recover [OPTIONS...]" -options :: [OptDescr Flag]+options :: [OptDescr (Options -> IO Options)] options = [ Option "h?" ["help"]- (NoArg Help)+ (NoArg $ \_ -> do+ hPutStr stderr (usageInfo header options)+ exitSuccess+ ) "show this help" , Option "V" ["version"]- (NoArg Version)+ (NoArg $ \_ -> do+ hPutStrLn stderr versionStr+ exitSuccess+ ) "show the version number" , Option "i" ["infile"]- (ReqArg InFile "FILE")- "read from this file instead of ~/.arbtt/capture.log"+ (ReqArg (\arg opt -> return opt { optInFile = arg }) "FILE")+ "read from this file instead of ~/.arbtt/capture.log" , Option "o" ["outfile"]- (ReqArg OutFile "FILE")- "write to this file instead of ~/.arbtt/capture.log.recovered"+ (ReqArg (\arg opt -> return opt { optOutFile = arg }) "FILE")+ "write to this file instead of ~/.arbtt/capture.log.recovered" ] main = do commonStartup args <- getArgs- flags <- case getOpt Permute options args of- (o,[],[]) | Help `notElem` o && Version `notElem` o -> return o- (o,_,_) | Version `elem` o -> do- hPutStrLn stderr versionStr- exitSuccess- (o,_,_) | Help `elem` o -> do- hPutStr stderr (usageInfo header options)- exitSuccess+ actions <- case getOpt Permute options args of+ (o,[],[]) -> return o (_,_,errs) -> do hPutStr stderr (concat errs ++ usageInfo header options) exitFailure- dir <- getAppUserDataDirectory "arbtt"-- let captureFilename =- fromMaybe (dir </> "capture.log") $ listToMaybe $- mapMaybe (\f -> case f of { InFile f -> Just f; _ -> Nothing}) $- flags- let saveFilename =- fromMaybe (dir </> "capture.log.recovered") $ listToMaybe $- mapMaybe (\f -> case f of { OutFile f -> Just f; _ -> Nothing}) $- flags+ flags <- foldl (>>=) (return (defaultOptions dir)) actions - captures <- recoverTimeLog captureFilename :: IO (TimeLog CaptureData)- writeTimeLog saveFilename captures+ captures <- recoverTimeLog (optInFile flags) :: IO (TimeLog CaptureData)+ writeTimeLog (optOutFile flags) captures
src/stats-main.hs view
@@ -6,86 +6,119 @@ import System.Exit import System.IO import Control.Monad-import qualified Data.Map as M import qualified Data.MyText as T import Data.Char (toLower)-import Data.List-import Data.Ord-import Data.Time import Text.Printf-import Data.Maybe import Data.Version (showVersion) import TimeLog-import Data import Categorize import Stats import CommonStartup import Paths_arbtt (version) -data Flag = Help | Version |- Report Report |- Filter Filter |- ReportOption ReportOption |- LogFile String |- CategorizeFile String- deriving Eq--getReports = mapMaybe (\f -> case f of {Report r -> Just r; _ -> Nothing})-getFilters = mapMaybe (\f -> case f of {Filter f -> Just f; _ -> Nothing})-getRepOpts = mapMaybe (\f -> case f of {ReportOption o -> Just o; _ -> Nothing})+data Options = Options+ { optReports :: [Report]+ , optFilters :: [Filter]+ , optAlsoInactive :: Bool+ , optReportOptions :: ReportOptions+ , optLogFile :: String+ , optCategorizeFile :: String+ } +defaultOptions :: FilePath -> Options+defaultOptions dir = Options+ { optReports = []+ , optFilters = []+ , optAlsoInactive = False+ , optReportOptions = defaultReportOptions+ , optLogFile = dir </> "capture.log"+ , optCategorizeFile = dir </> "categorize.cfg"+ }+ +versionStr, header :: String versionStr = "arbtt-stats " ++ showVersion version header = "Usage: arbtt-stats [OPTIONS...]" -options :: [OptDescr Flag]+options :: [OptDescr (Options -> IO Options)] options = [ Option "h?" ["help"]- (NoArg Help)+ (NoArg $ \_ -> do+ hPutStr stderr (usageInfo header options)+ exitSuccess+ ) "show this help" , Option "V" ["version"]- (NoArg Version)+ (NoArg $ \_ -> do+ hPutStrLn stderr versionStr+ exitSuccess+ ) "show the version number" -- , Option ['g'] ["graphical"] (NoArg Graphical) "render the reports as graphical charts" , Option "" ["logfile"]- (ReqArg LogFile "FILE")+ (ReqArg (\arg opt -> return opt { optLogFile = arg }) "FILE") "use this file instead of ~/.arbtt/capture.log" , Option "" ["categorizefile"]- (ReqArg CategorizeFile "FILE")+ (ReqArg (\arg opt -> return opt { optCategorizeFile = arg }) "FILE") "use this file instead of ~/.arbtt/categorize.cfg" , Option "x" ["exclude"]- (ReqArg (Filter . Exclude . read) "TAG")- "ignore samples containing this tag"+ (ReqArg (\arg opt -> let filters = Exclude (parseActivityMatcher arg) : optFilters opt+ in return opt { optFilters = filters }) "TAG")+ "ignore samples containing this tag or category" , Option "o" ["only"]- (ReqArg (Filter . Only . read) "TAG")- "only consider samples containing this tag"+ (ReqArg (\arg opt -> let filters = Only (parseActivityMatcher arg) : optFilters opt+ in return opt { optFilters = filters }) "TAG")+ "only consider samples containing this tag or category" , Option "" ["also-inactive"]- (NoArg (Filter AlsoInactive))+ (NoArg (\opt -> return opt { optAlsoInactive = True })) "include samples with the tag \"inactive\"" , Option "f" ["filter"]- (ReqArg (Filter . GeneralCond) "COND")+ (ReqArg (\arg opt -> let filters = GeneralCond arg : optFilters opt+ in return opt { optFilters = filters }) "COND") "only consider samples matching the condition" , Option "m" ["min-percentage"]- (ReqArg (ReportOption . MinPercentage . read) "PERC")+ (ReqArg (\arg opt -> let ro = (optReportOptions opt) { roMinPercentage = read arg}+ in return opt { optReportOptions = ro }) "COND") "do not show tags with a percentage lower than PERC% (default: 1)"+ , Option "" ["output-exclude"]+ (ReqArg (\arg opt -> let filters = ExcludeActivity (parseActivityMatcher arg) : roActivityFilter (optReportOptions opt)+ in return opt { optReportOptions = (optReportOptions opt) { roActivityFilter = filters }}) "TAG")+ "remove these tags from the output"+ , Option "" ["output-only"]+ (ReqArg (\arg opt -> let filters = OnlyActivity (parseActivityMatcher arg) : roActivityFilter (optReportOptions opt)+ in return opt { optReportOptions = (optReportOptions opt) { roActivityFilter = filters }}) "TAG")+ "only include these tags in the output" , Option "i" ["information"]- (NoArg (Report GeneralInfos))+ (NoArg (\opt -> let reports = GeneralInfos : optReports opt+ in return opt { optReports = reports })) "show general statistics about the data" , Option "t" ["total-time"]- (NoArg (Report TotalTime))+ (NoArg (\opt -> let reports = TotalTime : optReports opt+ in return opt { optReports = reports })) "show total time for each tag" , Option "c" ["category"]- (ReqArg (Report . Category . T.pack) "CATEGORY")+ (ReqArg (\arg opt -> let reports = Category (T.pack arg) : optReports opt+ in return opt { optReports = reports }) "CATEGORY") "show statistics about category CATEGORY" , Option "" ["each-category"]- (NoArg (Report EachCategory))+ (NoArg (\opt -> let reports = EachCategory : optReports opt+ in return opt { optReports = reports })) "show statistics about each category found"+ , Option "" ["intervals"]+ (ReqArg (\arg opt -> let report = if last arg == ':'+ then IntervalCategory (T.pack (init arg))+ else IntervalTag (read arg)+ reports = report : optReports opt+ in return opt { optReports = reports }) "TAG")+ "list intervals of tag or category TAG" , Option "" ["output-format"]- (ReqArg (ReportOption . OutputFormat . readReportFormat) "FORMAT")+ (ReqArg (\arg opt -> let ro = (optReportOptions opt) { roReportFormat = readReportFormat arg }+ in return opt { optReportOptions = ro }) "FORMAT") "one of: text, csv (comma-separated values), tsv (TAB-separated values) (default: Text)" ] +readReportFormat :: String -> ReportFormat readReportFormat arg = case (tolower arg) of "text" -> RFText@@ -95,56 +128,42 @@ where tolower = map toLower +main :: IO () main = do commonStartup args <- getArgs- flags <- case getOpt Permute options args of- (o,[],[]) | Help `notElem` o && Version `notElem` o -> return o- (o,_,_) | Version `elem` o -> do- hPutStrLn stderr versionStr- exitSuccess- (o,_,_) | Help `elem` o -> do- hPutStr stderr (usageInfo header options)- exitSuccess+ actions <- case getOpt Permute options args of+ (o,[],[]) -> return o (_,_,errs) -> do hPutStr stderr (concat errs ++ usageInfo header options) exitFailure dir <- getAppUserDataDirectory "arbtt"-- let captureFilename =- fromMaybe (dir </> "capture.log") $ listToMaybe $- mapMaybe (\f -> case f of { LogFile f -> Just f; _ -> Nothing}) $- flags-- let categorizeFilename =- fromMaybe (dir </> "categorize.cfg") $ listToMaybe $- mapMaybe- (\f -> case f of { CategorizeFile f -> Just f; _ -> Nothing}) $- flags+ flags <- foldl (>>=) (return (defaultOptions dir)) actions - fileEx <- doesFileExist categorizeFilename+ fileEx <- doesFileExist (optCategorizeFile flags) unless fileEx $ do- putStrLn $ printf "Configuration file %s does not exist." categorizeFilename+ putStrLn $ printf "Configuration file %s does not exist." (optCategorizeFile flags) putStrLn "Please see the example file and the README for more details" exitFailure- categorizer <- readCategorizer categorizeFilename+ categorizer <- readCategorizer (optCategorizeFile flags) - captures <- readTimeLog captureFilename+ captures <- readTimeLog (optLogFile flags) let allTags = categorizer captures when (null allTags) $ do putStrLn "Nothing recorded yet" exitFailure - let tags = applyFilters (getFilters flags) allTags- let reps = case getReports flags of {[] -> [TotalTime]; reps -> reps }+ let filters = (if optAlsoInactive flags then id else (defaultFilter:)) $ optFilters flags+ let tags = applyFilters filters allTags+ let reps = case optReports flags of {[] -> [TotalTime]; reps -> reverse reps } -- These are defined here, but of course only evaluated when any report -- refers to them. Some are needed by more than one report, which is then -- advantageous. let c = prepareCalculations allTags tags - putReports (getRepOpts flags) c reps+ putReports (optReportOptions flags) c reps {- import Data.Accessor