diff --git a/arbtt.cabal b/arbtt.cabal --- a/arbtt.cabal +++ b/arbtt.cabal @@ -1,10 +1,10 @@ -cabal-version: >= 1.6 -build-type: Simple name: arbtt -version: 0.1 +version: 0.1.1 license: GPL license-file: LICENSE -category: Development +category: Desktop +cabal-version: >= 1.6 +build-type: Simple author: Joachim Breitner maintainer: Joachim Breitner copyright: Joachim Breitner 2009 @@ -25,7 +25,7 @@ categorize.cfg, arbtt-capture.desktop, README executable arbtt-capture - main-is: capture.hs + main-is: capture-main.hs hs-source-dirs: src build-depends: base == 4.*, filepath, directory, mtl, time, unix, @@ -38,7 +38,7 @@ Graphics.X11.XScreenSaver executable arbtt-stats - main-is: stats.hs + main-is: stats-main.hs hs-source-dirs: src build-depends: base == 4.*, parsec == 2.*, containers, pcre-light, tabular diff --git a/src/capture-main.hs b/src/capture-main.hs new file mode 100644 --- /dev/null +++ b/src/capture-main.hs @@ -0,0 +1,32 @@ +module Main where + +import Control.Monad +import Control.Concurrent + +import Capture +import TimeLog +import System.Directory +import System.FilePath +import Graphics.X11.XScreenSaver (compiledWithXScreenSaver) +import System.IO +import System.Posix.IO +import System.IO.Error +import System.Exit + + +-- | sampleRate in seconds +sampleRate = 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 + setLock fd (WriteLock, AbsoluteSeek, 0, 0) + +main = do + unless compiledWithXScreenSaver $ + hPutStrLn stderr "arbtt [Warning]: X11 was compiled without support for XScreenSaver" + dir <- getAppUserDataDirectory "arbtt" + createDirectoryIfMissing False dir + let captureFile = dir "capture.log" + lockFile captureFile + runLogger captureFile (sampleRate * 1000) captureData diff --git a/src/capture.hs b/src/capture.hs deleted file mode 100644 --- a/src/capture.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Main where - -import Control.Monad -import Control.Concurrent - -import Capture -import TimeLog -import System.Directory -import System.FilePath -import Graphics.X11.XScreenSaver (compiledWithXScreenSaver) -import System.IO -import System.Posix.IO -import System.IO.Error -import System.Exit - - --- | sampleRate in seconds -sampleRate = 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 - setLock fd (WriteLock, AbsoluteSeek, 0, 0) - -main = do - unless compiledWithXScreenSaver $ - hPutStrLn stderr "arbtt [Warning]: X11 was compiled without support for XScreenSaver" - dir <- getAppUserDataDirectory "arbtt" - createDirectoryIfMissing False dir - let captureFile = dir "capture.log" - lockFile captureFile - runLogger captureFile (sampleRate * 1000) captureData diff --git a/src/stats-main.hs b/src/stats-main.hs new file mode 100644 --- /dev/null +++ b/src/stats-main.hs @@ -0,0 +1,137 @@ +module Main where +import System.Directory +import System.FilePath +import System.Console.GetOpt +import System.Environment +import System.Exit +import System.IO +import Control.Monad +import qualified Data.Map as M +import Data.List +import Data.Ord +import Data.Time +import Text.Printf +import Data.Maybe +import Data.Version (showVersion) +import qualified Text.Tabular.AsciiArt as TA + +import TimeLog +import Data +import Categorize +import Stats + +import Paths_arbtt (version) + +data Flag = Help | Version | + Report Report | + Filter Filter | + ReportOption ReportOption + 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}) + +versionStr = "arbtt-stats " ++ showVersion version +header = "Usage: arbtt-stats [OPTIONS...]" + +options :: [OptDescr Flag] +options = + [ Option "h?" ["help"] + (NoArg Help) + "show this help" + , Option ['V'] ["version"] + (NoArg Version) + "show the version number" +-- , Option ['g'] ["graphical"] (NoArg Graphical) "render the reports as graphical charts" + , Option ['x'] ["exclude"] + (ReqArg (Filter . Exclude . Activity Nothing) "TAG") + "ignore samples containing this tag" + , Option ['o'] ["only"] + (ReqArg (Filter . Only . read) "TAG") + "only consider samples containing this tag" + , Option [] ["also-inactive"] + (NoArg (Filter AlsoInactive)) + "include samples with the tag \"inactive\"" + , Option ['m'] ["min-percentage"] + (ReqArg (ReportOption . MinPercentage . read) "PERC") + "do not show tags with a percentage lower than PERC% (default: 1)" + , Option ['i'] ["information"] + (NoArg (Report GeneralInfos)) + "show general statistics about the data" + , Option ['t'] ["total-time"] + (NoArg (Report TotalTime)) + "show total time for each tag" + , Option ['c'] ["category"] + (ReqArg (Report . Category) "CATEGORY") + "show statistics about category CATEGORY" + ] + + +main = do + 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 + + dir <- getAppUserDataDirectory "arbtt" + + let categorizeFilename = dir "categorize.cfg" + fileEx <- doesFileExist categorizeFilename + unless (fileEx) $ do + putStrLn $ printf "Configuration file %s does not exist." categorizeFilename + putStrLn $ "Please see the example file and the README for more details" + exitFailure + categorizer <- readCategorizer categorizeFilename + + let captureFilename = dir "capture.log" + captures <- readTimeLog captureFilename + let allTags = categorizer captures + when (null allTags) $ do + putStrLn "Nothing recorded yet" + exitFailure + + let tags = applyFilters (getFilters flags) allTags + let opts = case getRepOpts flags of {[] -> [MinPercentage 1]; ropts -> ropts } + let reps = case getReports flags of {[] -> [TotalTime]; reps -> 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 + + sequence_ $ intersperse (putStrLn "") + $ map (\r -> let (h,t) = renderReport opts c r in do + putStrLnUnderlined h + putStr (TA.render id id id t) + ) + $ reps + +putStrLnUnderlined str = do + putStrLn str + putStrLn $ map (const '=') str + + +{- +import Data.Accessor +import Graphics.Rendering.Chart +import Graphics.Rendering.Chart.Gtk + + graphicalReport TotalTime = do + let values = zipWith (\(k,v) n -> (PlotIndex n,[fromIntegral v::Double])) (M.toList sums) [1..] + let plot = plot_bars_values ^= values $ defaultPlotBars + let layoutaxis = laxis_generate ^= autoIndexAxis (map (show.fst) (M.toList sums)) $ + defaultLayoutAxis + let layout = layout1_plots ^= [Right (plotBars plot)] $ + layout1_bottom_axis ^= layoutaxis $ + defaultLayout1 + do renderableToWindow (toRenderable layout) 800 600 +-} diff --git a/src/stats.hs b/src/stats.hs deleted file mode 100644 --- a/src/stats.hs +++ /dev/null @@ -1,137 +0,0 @@ -module Main where -import System.Directory -import System.FilePath -import System.Console.GetOpt -import System.Environment -import System.Exit -import System.IO -import Control.Monad -import qualified Data.Map as M -import Data.List -import Data.Ord -import Data.Time -import Text.Printf -import Data.Maybe -import Data.Version (showVersion) -import qualified Text.Tabular.AsciiArt as TA - -import TimeLog -import Data -import Categorize -import Stats - -import Paths_arbtt (version) - -data Flag = Help | Version | - Report Report | - Filter Filter | - ReportOption ReportOption - 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}) - -versionStr = "arbtt-stats " ++ showVersion version -header = "Usage: arbtt-stats [OPTIONS...]" - -options :: [OptDescr Flag] -options = - [ Option "h?" ["help"] - (NoArg Help) - "show this help" - , Option ['V'] ["version"] - (NoArg Version) - "show the version number" --- , Option ['g'] ["graphical"] (NoArg Graphical) "render the reports as graphical charts" - , Option ['x'] ["exclude"] - (ReqArg (Filter . Exclude . Activity Nothing) "TAG") - "ignore samples containing this tag" - , Option ['o'] ["only"] - (ReqArg (Filter . Only . read) "TAG") - "only consider samples containing this tag" - , Option [] ["also-inactive"] - (NoArg (Filter AlsoInactive)) - "include samples with the tag \"inactive\"" - , Option ['m'] ["min-percentage"] - (ReqArg (ReportOption . MinPercentage . read) "PERC") - "do not show tags with a percentage lower than PERC% (default: 1)" - , Option ['i'] ["information"] - (NoArg (Report GeneralInfos)) - "show general statistics about the data" - , Option ['t'] ["total-time"] - (NoArg (Report TotalTime)) - "show total time for each tag" - , Option ['c'] ["category"] - (ReqArg (Report . Category) "CATEGORY") - "show statistics about category CATEGORY" - ] - - -main = do - 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 - - dir <- getAppUserDataDirectory "arbtt" - - let categorizeFilename = dir "categorize.cfg" - fileEx <- doesFileExist categorizeFilename - unless (fileEx) $ do - putStrLn $ printf "Configuration file %s does not exist." categorizeFilename - putStrLn $ "Please see the example file and the README for more details" - exitFailure - categorizer <- readCategorizer categorizeFilename - - let captureFilename = dir "capture.log" - captures <- readTimeLog captureFilename - let allTags = categorizer captures - when (null allTags) $ do - putStrLn "Nothing recorded yet" - exitFailure - - let tags = applyFilters (getFilters flags) allTags - let opts = case getRepOpts flags of {[] -> [MinPercentage 1]; ropts -> ropts } - let reps = case getReports flags of {[] -> [TotalTime]; reps -> 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 - - sequence_ $ intersperse (putStrLn "") - $ map (\r -> let (h,t) = renderReport opts c r in do - putStrLnUnderlined h - putStr (TA.render id id id t) - ) - $ reps - -putStrLnUnderlined str = do - putStrLn str - putStrLn $ map (const '=') str - - -{- -import Data.Accessor -import Graphics.Rendering.Chart -import Graphics.Rendering.Chart.Gtk - - graphicalReport TotalTime = do - let values = zipWith (\(k,v) n -> (PlotIndex n,[fromIntegral v::Double])) (M.toList sums) [1..] - let plot = plot_bars_values ^= values $ defaultPlotBars - let layoutaxis = laxis_generate ^= autoIndexAxis (map (show.fst) (M.toList sums)) $ - defaultLayoutAxis - let layout = layout1_plots ^= [Right (plotBars plot)] $ - layout1_bottom_axis ^= layoutaxis $ - defaultLayout1 - do renderableToWindow (toRenderable layout) 800 600 --}