1module Main where 2import System.Directory 3import System.FilePath 4import System.Console.GetOpt 5import System.Environment 6import System.Exit 7import System.IO 8import Control.Monad 9import Data.Maybe 10import Data.Char (toLower) 11import Text.Printf 12import Data.Version (showVersion) 13import Control.DeepSeq 14import Control.Applicative 15import qualified Data.ByteString.Lazy as BS 16import Data.ByteString.Lazy.Progress 17import System.ProgressBar 18import TermSize 19import qualified Data.MyText as T 20import qualified Data.Text.Lazy as TL 21import Data.Time.LocalTime 22 23import TimeLog 24import Categorize 25import Stats 26import CommonStartup 27import LeftFold 28import DumpFormat 29 30import Paths_arbtt (version) 31 32data 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 42defaultOptions :: FilePath -> Options 43defaultOptions 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 53versionStr, header :: String 54versionStr = "arbtt-stats " ++ showVersion version 55header = "Usage: arbtt-stats [OPTIONS...]" 56 57options :: [OptDescr (Options -> IO Options)] 58options = 59 [ Option "h?" ["help"] 60 (NoArg $ \_ -> do 61 putStr (usageInfo header options) 62 exitSuccess 63 ) 64 "show this help" 65 , Option "V" ["version"] 66 (NoArg $ \_ -> do 67 putStrLn 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 }) "PERC") 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 142readRepeater :: String -> Repeater 143readRepeater 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 152readReportFormat :: String -> ReportFormat 153readReportFormat arg = 154 case map toLower arg of 155 "text" -> RFText 156 "csv" -> RFCSV 157 "tsv" -> RFTSV 158 _ -> error ("Unsupported report output format: '" ++ arg ++ "'") 159 160main :: IO () 161main = 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 timeloghandle <- openBinaryFile (optLogFile flags) ReadMode 182 size <- hFileSize timeloghandle 183 timelog <- BS.hGetContents timeloghandle 184 isTerm <- hIsTerminalDevice stderr 185 186 trackedTimelog <- case isTerm of 187 True -> do 188 hSetBuffering stderr NoBuffering 189 let pbStyle = defStyle { stylePrefix = msg (TL.pack "Processing data") 190 , stylePostfix = percentage } 191 pb <- hNewProgressBar stderr pbStyle 10 (Progress 0 100 ()) 192 trackProgressWithChunkSize (fromIntegral size `div` 100) 193 (\_ b -> updateProgress pb (const (Progress (fromIntegral b) (fromIntegral size) ()))) 194 timelog 195 False -> return timelog 196 197 let captures = parseTimeLog trackedTimelog 198 let allTags = categorizer captures 199 200 when (null allTags) $ do 201 putStrLn "Nothing recorded yet" 202 exitFailure 203 204 let filters = (if optAlsoInactive flags then id else (defaultFilter:)) $ optFilters flags 205 206 let rep = case optReports flags of 207 [] -> TotalTime 208 [x] -> x 209 _ -> error "Please specify exactly one report to generate" 210 let repeater = foldr (.) id $ map (processRepeater tz) (optRepeater flags) 211 212 let opts = optReportOptions flags 213 let fold = filterPredicate filters `adjoin` repeater (processReport tz opts rep) 214 let result = runLeftFold fold allTags 215 216 -- Force the results a bit, to ensure the progress bar to be shown before the title 217 result `seq` return () 218 219 renderReport opts result 220 221{- 222import Data.Accessor 223import Graphics.Rendering.Chart 224import Graphics.Rendering.Chart.Gtk 225 226 graphicalReport TotalTime = do 227 let values = zipWith (\(k,v) n -> (PlotIndex n,[fromIntegral v::Double])) (M.toList sums) [1..] 228 let plot = plot_bars_values ^= values $ defaultPlotBars 229 let layoutaxis = laxis_generate ^= autoIndexAxis (map (show.fst) (M.toList sums)) $ 230 defaultLayoutAxis 231 let layout = layout1_plots ^= [Right (plotBars plot)] $ 232 layout1_bottom_axis ^= layoutaxis $ 233 defaultLayout1 234 do renderableToWindow (toRenderable layout) 800 600 235-} 236