diff --git a/arbtt.cabal b/arbtt.cabal
--- a/arbtt.cabal
+++ b/arbtt.cabal
@@ -1,5 +1,5 @@
name: arbtt
-version: 0.5
+version: 0.6
license: GPL
license-file: LICENSE
category: Desktop
diff --git a/categorize.cfg b/categorize.cfg
--- a/categorize.cfg
+++ b/categorize.cfg
@@ -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!
diff --git a/doc/arbtt.xml b/doc/arbtt.xml
--- a/doc/arbtt.xml
+++ b/doc/arbtt.xml
@@ -12,26 +12,26 @@
Joachim
Breitner
- mail@joachim-breitner.de
Main author of arbtt
+ mail@joachim-breitner.de
Sergey
Astanin
- s.astanin@gmail.com
Contributor
+ s.astanin@gmail.com
Martin
Kiefel
- mk@nopw.de
Contributor
+ mk@nopw.de
Muharem
Hrnjadovic
- muharem@linux.com
Contributor
+ muharem@linux.com
@@ -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.
-
- The log file might contain very sensitive private data. Make sure
+ 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.
+
@@ -549,7 +550,7 @@
shows the version number, and exists.
-
+ FILE
logfile to use instead of ~/.arbtt/capture.log
@@ -563,13 +564,15 @@
TAG
TAG
Ignore any data samples that have
- been assigned this tag. Can be given more than once.
+ 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.
TAG
TAB
Ignore any data samples that have
- not been assigned this tag. Can be given more than once.
+ 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.
@@ -598,6 +601,26 @@
+ TAG
+
+ Skip this tag or category when printing statistics. Only affects
+ the reports and
+ . To distinguish tags and categories,
+ the latter have to be entered followed by a colon. Can be given
+ more than once.
+
+
+
+ TAG
+
+ Prints statistics only for the specified tag or category. Only
+ affects the reports and
+ . To distinguish tags and categories,
+ the latter have to be entered followed by a colon. Can be given
+ more than once.
+
+
+
FORMAT
Specify the report output format, may be one of: text, csv
@@ -624,7 +647,7 @@
- For all tag, print the part of the selected time
+ 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.
@@ -645,6 +668,24 @@
the data.
+
+ [TAG|CATEGORY:]
+ 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.
+
+
+ To distinguish tags and categories, the latter have to be
+ entered followed by a colon.
+
+ 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 arbtt-capture is running
+ will separate the results as expected.
+
+
+
@@ -730,6 +771,11 @@
RATE
sets the sample rate in seconds (default: 60)
+
+ FILE
+ FILE
+ logfile to use instead of ~/.arbtt/capture.log
+
Files
@@ -791,8 +837,8 @@
shows the version number, and exists.
-
-
+ FILE
+ FILE
logfile to use instead of ~/.arbtt/capture.log
@@ -855,8 +901,8 @@
shows the version number, and exists.
-
-
+ FILE
+ FILE
logfile to use instead of ~/.arbtt/capture.log
@@ -991,6 +1037,35 @@
The version history with changes relevant for the user are documented here.
+
+
+ Version 0.6
+
+
+ The command arbtt-capture now supports the
+ .
+
+
+
+ New report “intervals”, available using arbtt-stats .
+
+
+
+ The paramters and
+ of arbtt-stats can match
+ categories as well as tags.
+
+
+
+ Bugfix: Numbers in tag names are no longer replaced by an underscore.
+
+
+ New paramters and
+ of arbtt-stats.
+
+
+
+
Version 0.5 (The ZuriHac-Release)
diff --git a/src/Categorize.hs b/src/Categorize.hs
--- a/src/Categorize.hs
+++ b/src/Categorize.hs
@@ -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"
diff --git a/src/Data/MyText.hs b/src/Data/MyText.hs
--- a/src/Data/MyText.hs
+++ b/src/Data/MyText.hs
@@ -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
diff --git a/src/Stats.hs b/src/Stats.hs
--- a/src/Stats.hs
+++ b/src/Stats.hs
@@ -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
diff --git a/src/capture-main.hs b/src/capture-main.hs
--- a/src/capture-main.hs
+++ b/src/capture-main.hs
@@ -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
diff --git a/src/dump-main.hs b/src/dump-main.hs
--- a/src/dump-main.hs
+++ b/src/dump-main.hs
@@ -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
diff --git a/src/import-main.hs b/src/import-main.hs
--- a/src/import-main.hs
+++ b/src/import-main.hs
@@ -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
diff --git a/src/recover-main.hs b/src/recover-main.hs
--- a/src/recover-main.hs
+++ b/src/recover-main.hs
@@ -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
diff --git a/src/stats-main.hs b/src/stats-main.hs
--- a/src/stats-main.hs
+++ b/src/stats-main.hs
@@ -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