packages feed

arbtt-0.6.4: src/stats-main.hs

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.MyText as T
import Data.Char (toLower)
import Text.Printf
import Data.Version (showVersion)
import Control.DeepSeq
import Control.Applicative

import TimeLog
import Categorize
import Stats
import CommonStartup
import LeftFold

import Paths_arbtt (version)

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 (Options -> IO Options)]
options =
     [ Option "h?"      ["help"]
              (NoArg $ \_ -> do
                    hPutStr stderr (usageInfo header options)
                    exitSuccess
              )
              "show this help"
     , Option "V"       ["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 (\arg opt -> return opt { optLogFile = arg }) "FILE")
               "use this file instead of ~/.arbtt/capture.log"
     , Option ""      ["categorizefile"]
              (ReqArg (\arg opt -> return opt { optCategorizeFile = arg }) "FILE")
               "use this file instead of ~/.arbtt/categorize.cfg"
     , Option "x"       ["exclude"]
              (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 (\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 (\opt ->      return opt { optAlsoInactive = True }))
              "include samples with the tag \"inactive\""
     , Option "f"       ["filter"]
              (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 (\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 (\opt ->      let reports = GeneralInfos : optReports opt
                                   in  return opt { optReports = reports }))
              "show general statistics about the data"
     , Option "t"       ["total-time"]
              (NoArg (\opt ->      let reports = TotalTime : optReports opt
                                   in  return opt { optReports = reports }))
              "show total time for each tag"
     , Option "c"       ["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 (\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 (\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
        "csv"  -> RFCSV
        "tsv"  -> RFTSV
        _      -> error ("Unsupported report output format: '" ++ arg ++ "'")
    where
        tolower = map toLower

main :: IO ()
main = do
  commonStartup
  args <- getArgs
  actions <- case getOpt Permute options args of
          (o,[],[])  -> return o
          (_,_,errs) -> do
                hPutStr stderr (concat errs ++ usageInfo header options)
                exitFailure

  dir <- getAppUserDataDirectory "arbtt"
  flags <- foldl (>>=) (return (defaultOptions dir)) actions

  fileEx <- doesFileExist (optCategorizeFile flags)
  unless fileEx $ do
     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 (optCategorizeFile flags)

  captures <- readTimeLog (optLogFile flags)
  let allTags = categorizer captures
  -- allTags `deepseq` return ()
  when (null allTags) $ do
     putStrLn "Nothing recorded yet"
     exitFailure
      
  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 opts = optReportOptions flags
  let (c,results) = runLeftFold (filterPredicate filters `filterWith` 
        (pure (,) <*> prepareCalculations <*> processReports opts c reps)) allTags
  
  --let results = runLeftFold (filterPredicate filters `filterWith` processReports opts reps) allTags
  renderReport opts (MultpleReportResults results)

{-
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
-}