Whitespace cleanup
[darcs-mirror-arbtt.git] / src / stats-main.hs
1 module Main where
2 import System.Directory
3 import System.FilePath
4 import System.Console.GetOpt
5 import System.Environment
6 import System.Exit
7 import System.IO
8 import Control.Monad
9 import Data.Maybe
10 import Data.Char (toLower)
11 import Text.Printf
12 import Data.Version (showVersion)
13 import Control.DeepSeq
14 import Control.Applicative
15 import qualified Data.ByteString.Lazy as BS
16 import Data.ByteString.Lazy.Progress
17 import System.Posix.Files
18 import System.ProgressBar
19 import TermSize
20 import qualified Data.MyText as T
21 import Data.Time.LocalTime
22
23 import TimeLog
24 import Categorize
25 import Stats
26 import CommonStartup
27 import LeftFold
28 import DumpFormat
29
30 import Paths_arbtt (version)
31
32 data Options = Options
33     { optReports :: [Report]
34     , optFilters :: [Filter]
35     , optRepeater :: [Repeater]
36     , optAlsoInactive :: Bool
37     , optReportOptions :: ReportOptions
38     , optLogFile :: String
39     , optCategorizeFile :: String
40     }
41
42 defaultOptions :: FilePath -> Options
43 defaultOptions dir = Options
44     { optReports = []
45     , optFilters = []
46     , optRepeater = []
47     , optAlsoInactive = False
48     , optReportOptions = defaultReportOptions
49     , optLogFile = dir </> "capture.log"
50     , optCategorizeFile = dir </> "categorize.cfg"
51     }
52     
53 versionStr, header :: String
54 versionStr = "arbtt-stats " ++ showVersion version
55 header = "Usage: arbtt-stats [OPTIONS...]"
56
57 options :: [OptDescr (Options -> IO Options)]
58 options =
59      [ Option "h?"      ["help"]
60               (NoArg $ \_ -> do
61                     hPutStr stderr (usageInfo header options)
62                     exitSuccess
63               )
64               "show this help"
65      , Option "V"       ["version"]
66               (NoArg $ \_ -> do
67                     hPutStrLn stderr versionStr
68                     exitSuccess
69               )
70               "show the version number"
71 --     , Option ['g']     ["graphical"] (NoArg Graphical)    "render the reports as graphical charts"
72      , Option ""      ["logfile"]
73               (ReqArg (\arg opt -> return opt { optLogFile = arg }) "FILE")
74                "use this file instead of ~/.arbtt/capture.log"
75      , Option ""      ["categorizefile"]
76               (ReqArg (\arg opt -> return opt { optCategorizeFile = arg }) "FILE")
77                "use this file instead of ~/.arbtt/categorize.cfg"
78      , Option "x"       ["exclude"]
79               (ReqArg (\arg opt -> let filters = Exclude (parseActivityMatcher arg) : optFilters opt
80                                    in  return opt { optFilters = filters }) "TAG")
81               "ignore samples containing this tag or category"
82      , Option "o"       ["only"]
83               (ReqArg (\arg opt -> let filters = Only (parseActivityMatcher arg) : optFilters opt
84                                    in  return opt { optFilters = filters }) "TAG")
85               "only consider samples containing this tag or category"
86      , Option ""        ["also-inactive"]
87               (NoArg (\opt ->      return opt { optAlsoInactive = True }))
88               "include samples with the tag \"inactive\""
89      , Option "f"       ["filter"]
90               (ReqArg (\arg opt -> let filters = GeneralCond arg : optFilters opt
91                                    in  return opt { optFilters = filters }) "COND")
92               "only consider samples matching the condition"
93      , Option "m"       ["min-percentage"]
94               (ReqArg (\arg opt -> let ro = (optReportOptions opt) { roMinPercentage = read arg}
95                                    in  return opt { optReportOptions = ro }) "COND")
96               "do not show tags with a percentage lower than PERC% (default: 1)"
97      , Option ""        ["output-exclude"]
98               (ReqArg (\arg opt -> let filters = ExcludeActivity (parseActivityMatcher arg) : roActivityFilter (optReportOptions opt)
99                                    in  return opt { optReportOptions = (optReportOptions opt) { roActivityFilter = filters }}) "TAG")
100               "remove these tags from the output"
101      , Option ""        ["output-only"]
102               (ReqArg (\arg opt -> let filters = OnlyActivity (parseActivityMatcher arg) : roActivityFilter (optReportOptions opt)
103                                    in  return opt { optReportOptions = (optReportOptions opt) { roActivityFilter = filters }}) "TAG")
104               "only include these tags in the output"
105      , Option "i"       ["information"]
106               (NoArg (\opt ->      let reports = GeneralInfos : optReports opt
107                                    in  return opt { optReports = reports }))
108               "show general statistics about the data"
109      , Option "t"       ["total-time"]
110               (NoArg (\opt ->      let reports = TotalTime : optReports opt
111                                    in  return opt { optReports = reports }))
112               "show total time for each tag"
113      , Option "c"       ["category"]
114               (ReqArg (\arg opt -> let reports = Category (T.pack arg) : optReports opt
115                                    in  return opt { optReports = reports }) "CATEGORY")
116               "show statistics about category CATEGORY"
117      , Option ""        ["each-category"]
118               (NoArg (\opt ->      let reports = EachCategory : optReports opt
119                                    in  return opt { optReports = reports }))
120               "show statistics about each category found"
121      , Option ""        ["intervals"]
122               (ReqArg (\arg opt -> let report = if last arg == ':'
123                                                 then IntervalCategory (T.pack (init arg))
124                                                 else IntervalTag (read arg)
125                                        reports = report : optReports opt
126                                    in  return opt { optReports = reports }) "TAG")
127               "list intervals of tag or category TAG"
128      , Option ""       ["dump-samples"]
129               (NoArg (\opt ->      let reports = DumpSamples : optReports opt
130                                    in  return opt { optReports = reports }))
131               "Dump the raw samples and tags."
132      , Option ""       ["output-format"]
133               (ReqArg (\arg opt -> let ro = (optReportOptions opt) { roReportFormat = readReportFormat arg }
134                                    in  return opt { optReportOptions = ro }) "FORMAT")
135               "one of: text, csv (comma-separated values), tsv (TAB-separated values) (default: Text)"
136      , Option ""       ["for-each"]
137               (ReqArg (\arg opt -> let repeater = readRepeater arg : optRepeater opt
138                                    in  return opt { optRepeater = repeater }) "PERIOD")
139               "one of: day, month, year"
140      ]
141
142 readRepeater :: String -> Repeater
143 readRepeater arg =
144     case map toLower arg of
145         "minute" -> ByMinute
146         "hour"   -> ByHour
147         "day"    -> ByDay
148         "month"  -> ByMonth
149         "year"   -> ByYear
150         _        -> error ("Unsupported parameter to --for-each: '" ++ arg ++ "'")
151
152 readReportFormat :: String -> ReportFormat
153 readReportFormat arg =
154     case map toLower arg of
155         "text" -> RFText
156         "csv"  -> RFCSV
157         "tsv"  -> RFTSV
158         _      -> error ("Unsupported report output format: '" ++ arg ++ "'")
159
160 main :: IO ()
161 main = do
162   commonStartup
163   args <- getArgs
164   actions <- case getOpt Permute options args of
165           (o,[],[])  -> return o
166           (_,_,errs) -> do
167                 hPutStr stderr (concat errs ++ usageInfo header options)
168                 exitFailure
169   tz <- getCurrentTimeZone
170
171   dir <- getAppUserDataDirectory "arbtt"
172   flags <- foldl (>>=) (return (defaultOptions dir)) actions
173
174   fileEx <- doesFileExist (optCategorizeFile flags)
175   unless fileEx $ do
176      putStrLn $ printf "Configuration file %s does not exist." (optCategorizeFile flags)
177      putStrLn "Please see the example file and the README for more details"
178      exitFailure
179   categorizer <- readCategorizer (optCategorizeFile flags)
180
181   timelog <- BS.readFile (optLogFile flags)
182   isTerm <- hIsTerminalDevice stderr
183
184   trackedTimelog <- case isTerm of
185     True -> do
186       hSetBuffering stderr NoBuffering
187       size <- fileSize <$> getFileStatus (optLogFile flags)
188       trackProgressWithChunkSize (fromIntegral size `div` 100) (\_ b -> do
189         (_height, width) <- getTermSize
190         hPutChar stderr '\r'
191         hPutStr stderr $
192             mkProgressBar (msg "Processing data") percentage (fromIntegral width) (fromIntegral b) (fromIntegral size)
193         when  (fromIntegral b >= fromIntegral size) $ do
194             hPutChar stderr '\r'
195             hPutStr stderr (replicate width ' ')
196             hPutChar stderr '\r'
197         ) timelog
198     False -> return timelog
199
200   let captures = parseTimeLog trackedTimelog
201   let allTags = categorizer captures
202
203   when (null allTags) $ do
204      putStrLn "Nothing recorded yet"
205      exitFailure
206
207   let filters = (if optAlsoInactive flags then id else (defaultFilter:)) $ optFilters flags
208
209   let rep = case optReports flags of
210                 [] -> TotalTime
211                 [x] -> x
212                 _ -> error "Please specify exactly one report to generate"
213   let repeater = foldr (.) id $ map (processRepeater tz) (optRepeater flags)
214
215   let opts = optReportOptions flags
216   let fold = filterPredicate filters `adjoin` repeater (processReport opts rep)
217   let result = runLeftFold fold allTags
218
219   -- Force the results a bit, to ensure the progress bar to be shown before the title
220   result `seq` return ()
221
222   renderReport opts result
223
224 {-
225 import Data.Accessor
226 import Graphics.Rendering.Chart
227 import Graphics.Rendering.Chart.Gtk
228
229         graphicalReport TotalTime = do
230           let values = zipWith (\(k,v) n -> (PlotIndex n,[fromIntegral v::Double])) (M.toList sums) [1..]
231           let plot = plot_bars_values ^= values $ defaultPlotBars
232           let layoutaxis = laxis_generate ^= autoIndexAxis (map (show.fst) (M.toList  sums)) $
233                            defaultLayoutAxis
234           let layout = layout1_plots ^= [Right (plotBars plot)] $
235                        layout1_bottom_axis ^= layoutaxis $
236                        defaultLayout1
237           do renderableToWindow (toRenderable layout) 800 600
238 -}