diff --git a/README b/README --- a/README +++ b/README @@ -25,12 +25,15 @@ full path to arbtt-capture in the Exec line there, if you did not do a system wide installation. +If you want to record samples at a different rate than one per minute, you +will have to pass the "--sample-rate" parameter to arbtt-capture. + Configuration ============= Once arbtt-capture is running, it will start recording, without further configuration. The configuration is only needed to do an analysis of the -recorded data. Thus, if you improve your categorization there, it will +recorded data. Thus, if you improve your categorization later, it will apply even to previous data samples! The configuration file needs to be placed in ~/.arbtt/categorize.cfg. An @@ -50,13 +53,17 @@ | "$" SVar "==" String | "$" SVar "/=" String | "$" SVar "=~" "/" Regex "/" | | "$" NVar NOp Number + | "$" TVar NOp TSpec | "$" BVar - | "current window" $cond - | "any window" $cond + | "current window" Cond + | "any window" Cond +NOp := "<=" | "<" | "==" | ">" | ">=" + SVar := "title" | "program" NVar := "idle" BVar := "active" +TVar := "time" | "sampleage" The variables $title, $program, $active refer to the "window in scope". At first, no window is in scope. Only when evaluating the condition passed to @@ -87,6 +94,12 @@ The title or the name of the currently active program. If no program happens to be active, this tag will be ignored. +The variable $time refers to the time-of-day of the sample (i.e. the time +since 0:00 that day), while $sampleage refers to the timespan from when the +sample was created until now, the time of evaluating the statistics. They +can be compared with expressions of the type "hh:mm", for example: + $time >= 8:00 && $time < 12:00 ==> tag time-of-day:morning, + Statistics ========== @@ -100,6 +113,10 @@ be mixed with the report options (-m) and the reports (-i, -t, -c), but will apply to all reports. +The flag --filter (-f) allows you to sepecify an arbitrary complex +condition using the same syntax for conditions that you can use in the +categorize.cfg file. + Some useful examples: # Only consider the time when I was programming in Haskell @@ -107,7 +124,10 @@ # Tell me what evolution folders I spend my time in when I actually do # work with e-Mail - are arbtt-stats -o Program:evolution -c Evo-Folder + arbtt-stats -o Program:evolution -c Evo-Folder + + # Generate statistics about the last hour + arbtt-stats -f '$sampleage < 1:00' Development =========== diff --git a/arbtt.cabal b/arbtt.cabal --- a/arbtt.cabal +++ b/arbtt.cabal @@ -1,5 +1,5 @@ name: arbtt -version: 0.1.5 +version: 0.2.0 license: GPL license-file: LICENSE category: Desktop diff --git a/categorize.cfg b/categorize.cfg --- a/categorize.cfg +++ b/categorize.cfg @@ -28,3 +28,14 @@ -- Out of curiosity: what percentage of my time am I actually coding Haskell? current window ($program == "gvim" && $title =~ /^[^ ]+\.hs \(/ ) ==> tag Editing-Haskell, + +-- To be able to match on the time of day, I introduce tags for that as well +$time >= 2:00 && $time < 8:00 ==> tag time-of-day:night, +$time >= 8:00 && $time < 12:00 ==> tag time-of-day:morning, +$time >= 12:00 && $time < 14:00 ==> tag time-of-day:lunchtime, +$time >= 14:00 && $time < 18:00 ==> tag time-of-day:afternoon, +$time >= 18:00 && $time < 22:00 ==> tag time-of-day:evening, +$time >= 22:00 || $time < 2:00 ==> tag time-of-day:late-evening, + +-- This tag always refers to the last 24h +$sampleage <= 24:00 ==> tag last-day, diff --git a/src/Categorize.hs b/src/Categorize.hs --- a/src/Categorize.hs +++ b/src/Categorize.hs @@ -3,7 +3,6 @@ import Data import Data.Maybe --- import Text.Regex import qualified Text.Regex.PCRE.Light.Char8 as RE import qualified Data.Map as M import Control.Monad @@ -18,19 +17,22 @@ import Data.List import Data.Maybe import Data.Char +import Data.Time.Clock import Debug.Trace +import Control.Arrow (second) -type Categorizer = TimeLog CaptureData -> TimeLog ActivityData +type Categorizer = TimeLog CaptureData -> TimeLog (Ctx, ActivityData) type Rule = Ctx -> ActivityData type Parser a = CharParser () a data Ctx = Ctx - { cNow :: CaptureData - , cPast :: [CaptureData] - , cFuture :: [CaptureData] + { cNow :: TimeLogEntry CaptureData + , cPast :: [TimeLogEntry CaptureData] + , cFuture :: [TimeLogEntry CaptureData] , cWindowInScope :: Maybe (Bool, String, String) , cSubsts :: [String] + , cCurrentTime :: UTCTime } deriving (Show) @@ -39,19 +41,27 @@ readCategorizer :: FilePath -> IO Categorizer readCategorizer filename = do content <- readFile filename + time <- getCurrentTime case parse (do {r <- parseRules; eof ; return r}) filename content of Left err -> do putStrLn "Parser error:" putStrLn (show err) exitFailure - Right cat -> return ((fmap . fmap) (postpare . cat) . prepare) + Right cat -> return ((fmap . fmap) (mkSecond (postpare . cat)) . prepare time) -prepare :: TimeLog CaptureData -> TimeLog Ctx -prepare tl = go' [] (map tlData tl) tl +applyCond :: String -> TimeLog (Ctx, ActivityData) -> TimeLog (Ctx, ActivityData) +applyCond s = + case parse (do {c <- parseCond; eof ; return c}) "commad line parameter" s of + Left err -> do + error (show err) + Right c -> filter (isJust . c . fst . tlData) + +prepare :: UTCTime -> TimeLog CaptureData -> TimeLog Ctx +prepare time tl = go' [] tl tl where go' past [] [] = [] go' past (this:future) (now:rest) - = now {tlData = Ctx this past future Nothing [] } : + = now {tlData = Ctx now past future Nothing [] time } : go' (this:past) future rest -- | Here, we filter out tags appearing twice, and make sure that only one of @@ -86,7 +96,7 @@ s2 <- stringLiteral lang return (s1,s2) -parseRulesBody :: Parser (Ctx -> ActivityData) +parseRulesBody :: Parser Rule parseRulesBody = do x <- parseRule choice [ do comma lang @@ -137,6 +147,16 @@ checkNot :: Cond -> Cond checkNot = liftM (maybe (Just []) (const Nothing)) +parseCmp :: Ord a => Parser (a -> a -> Bool) +parseCmp = choice $ map (\(s,o) -> reservedOp lang s >> return o) + [(">=",(>=)), + (">", (>)), + ("=", (==)), + ("==",(==)), + ("<",(<)), + ("<=",(<=))] + + parseCondPrim :: Parser Cond parseCondPrim = choice [ parens lang parseCond @@ -156,15 +176,13 @@ return $ checkNot (checkEq varname str) ] , do guard $ varname == "idle" - op <- choice $ map (\(s,o) -> reservedOp lang s >> return o) - [(">=",(>=)), - (">", (>)), - ("=", (==)), - ("==",(==)), - ("<",(<)), - ("<=",(<=))] + op <- parseCmp num <- natural lang return $ checkNumCmp op varname num + , do guard $ varname `elem` ["time","sampleage"] + op <- parseCmp + time <- parseTime + return $ checkTimeCmp op varname time , do guard $ varname == "active" return $ checkActive ] @@ -186,6 +204,16 @@ return str ] +-- | Parses a day-of-time specification (hh:mm) +parseTime :: Parser NominalDiffTime +parseTime = fmap fromIntegral $ lexeme lang $ do + h <- digitToInt <$> digit + mh <- optionMaybe (do{ digitToInt <$> digit }) + char ':' + m1 <- digitToInt <$> digit + m2 <- digitToInt <$> digit + let hour = maybe h ((10*h)+) mh + return $ (hour * 60 + m1 * 10 + m2) * 60 parseSetTag :: Parser Rule parseSetTag = lexeme lang $ do @@ -237,7 +265,7 @@ listToMaybe (drop (n-1) (cSubsts ctx)) getVar v ctx | "current" `isPrefixOf` v = do let var = drop (length "current.") v - win <- findActive $ cWindows (cNow ctx) + win <- findActive $ cWindows (tlData (cNow ctx)) getVar var (ctx { cWindowInScope = Just win }) getVar "title" ctx = do (_,t,_) <- cWindowInScope ctx @@ -259,11 +287,11 @@ findActive = find (\(a,_,_) -> a) checkCurrentwindow :: Cond -> Cond -checkCurrentwindow cond ctx = cond (ctx { cWindowInScope = findActive (cWindows (cNow ctx)) }) +checkCurrentwindow cond ctx = cond (ctx { cWindowInScope = findActive (cWindows (tlData (cNow ctx))) }) checkAnyWindow :: Cond -> Cond checkAnyWindow cond ctx = msum $ map (\w -> cond (ctx { cWindowInScope = Just w })) - (cWindows (cNow ctx)) + (cWindows (tlData (cNow ctx))) checkActive :: Cond checkActive ctx = do (a,_,_) <- cWindowInScope ctx @@ -271,11 +299,22 @@ return [] checkNumCmp :: (Integer -> Integer -> Bool) -> String -> Integer -> Cond -checkNumCmp op "idle" num ctx = [] `justIf` op (cLastActivity (cNow ctx)) (num*1000) +checkNumCmp () "idle" num ctx = [] `justIf` (cLastActivity (tlData (cNow ctx)) (num*1000)) +checkTimeCmp :: (NominalDiffTime -> NominalDiffTime -> Bool) -> String -> NominalDiffTime -> Cond +checkTimeCmp () "time" num ctx = + let time = tlTime (cNow ctx) `diffUTCTime` (tlTime (cNow ctx)) { utctDayTime = fromIntegral 0} + in [] `justIf` (time num) +checkTimeCmp () "sampleage" num ctx = + let age = cCurrentTime ctx `diffUTCTime` tlTime (cNow ctx) + in [] `justIf` (age num) + matchNone :: Rule matchNone = const [] justIf :: a -> Bool -> Maybe a justIf x True = Just x justIf x False = Nothing + +mkSecond :: (a -> b) -> a -> (a, b) +mkSecond f a = (a, f a) diff --git a/src/Stats.hs b/src/Stats.hs --- a/src/Stats.hs +++ b/src/Stats.hs @@ -10,28 +10,30 @@ import qualified Data.Map as M import Data +import Categorize data Report = GeneralInfos | TotalTime | Category String deriving Eq -data Filter = Exclude Activity | Only Activity | AlsoInactive +data Filter = Exclude Activity | Only Activity | AlsoInactive | GeneralCond String deriving Eq data ReportOption = MinPercentage Double deriving Eq -applyFilters :: [Filter] -> TimeLog ActivityData -> TimeLog ActivityData +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 -excludeTag act = filter (notElem act . tlData) -onlyTag act = filter (elem act . tlData) +excludeTag act = filter (notElem act . snd . tlData) +onlyTag act = filter (elem act . snd . tlData) defaultFilter = excludeTag inactiveActivity -- | to be used lazily, to re-use computation when generating more than one @@ -46,11 +48,11 @@ , fractionSel :: Double , fractionSelRec :: Double , sums :: M.Map Activity Integer - , allTags :: TimeLog ActivityData - , tags :: TimeLog ActivityData + , allTags :: TimeLog (Ctx, ActivityData) + , tags :: TimeLog (Ctx, ActivityData) } -prepareCalculations :: TimeLog ActivityData -> TimeLog ActivityData -> Calculations +prepareCalculations :: TimeLog (Ctx, ActivityData) -> TimeLog (Ctx, ActivityData) -> Calculations prepareCalculations allTags tags = let c = Calculations { firstDate = tlTime (head allTags) @@ -67,9 +69,9 @@ } in c -- | Sums up each occurence of an 'Activity', weighted by the sampling rate -sumUp :: TimeLog ActivityData -> M.Map Activity Integer +sumUp :: TimeLog (Ctx, ActivityData) -> M.Map Activity Integer sumUp = foldr go (M.empty) - where go tl m = foldr go' m (tlData tl) + where go tl m = foldr go' m (snd (tlData tl)) where go' act = M.insertWith (+) act (tlRate tl) diff --git a/src/capture-main.hs b/src/capture-main.hs --- a/src/capture-main.hs +++ b/src/capture-main.hs @@ -2,9 +2,6 @@ import Control.Monad import Control.Concurrent - -import Capture -import TimeLog import System.Directory import System.FilePath import Graphics.X11.XScreenSaver (compiledWithXScreenSaver) @@ -13,10 +10,41 @@ import System.IO.Error import System.Exit import System.Locale.SetLocale +import System.Console.GetOpt +import System.Environment +import Data.Maybe +import Data.Version (showVersion) --- | sampleRate in seconds -sampleRate = 60 +import Capture +import TimeLog +import Paths_arbtt (version) + + +data Conf = Conf { + cSampleRate :: Integer + } +defaultConf = Conf 60 + +data Opts = Help | Version | SetRate Integer + deriving Eq + +versionStr = "arbtt-capture " ++ showVersion version +header = "Usage: arbtt-capture [OPTIONS...]" + +options :: [OptDescr Opts] +options = + [ Option "h?" ["help"] + (NoArg Help) + "show this help" + , Option ['V'] ["version"] + (NoArg Version) + "show the version number" + , Option ['r'] ["sample-rate"] + (ReqArg (SetRate . read) "RATE") + "set the sample rate in seconds (default: 60)" + ] + -- | This is very raw, someone ought to improve this lockFile filename = flip catch (\e -> hPutStrLn stderr ("arbtt [Error]: Could not aquire lock for " ++ filename ++"!") >> exitFailure) $ do fd <- openFd (filename ++ ".lck") WriteOnly (Just 0644) defaultFileFlags @@ -26,6 +54,24 @@ setLocale LC_ALL (Just "") unless compiledWithXScreenSaver $ hPutStrLn stderr "arbtt [Warning]: X11 was compiled without support for XScreenSaver" + + 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 + 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" createDirectoryIfMissing False dir let captureFile = dir "capture.log" diff --git a/src/stats-main.hs b/src/stats-main.hs --- a/src/stats-main.hs +++ b/src/stats-main.hs @@ -53,6 +53,9 @@ , Option [] ["also-inactive"] (NoArg (Filter AlsoInactive)) "include samples with the tag \"inactive\"" + , Option ['f'] ["filter"] + (ReqArg (Filter . GeneralCond) "COND") + "only consider samples matching the condition" , Option ['m'] ["min-percentage"] (ReqArg (ReportOption . MinPercentage . read) "PERC") "do not show tags with a percentage lower than PERC% (default: 1)"