Interval report: Correctly split intervals when no data came in
[darcs-mirror-arbtt.git] / src / Stats.hs
index fe11008..c79968a 100644 (file)
@@ -1,5 +1,21 @@
-{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
-module Stats where
+{-# LANGUAGE RecordWildCards, NamedFieldPuns, TypeOperators, TupleSections, GADTSyntax, ExistentialQuantification, CPP #-}
+module Stats (
+    Report(..),
+    ReportOptions(..),
+    ReportFormat(..),
+    ReportResults(..),
+    ActivityFilter(..),
+    Filter(..),
+    Repeater(..),
+    defaultFilter,
+    defaultReportOptions,
+    parseActivityMatcher,
+    filterPredicate,
+    prepareCalculations,
+    processReport,
+    processRepeater,
+    renderReport
+    ) where
 
 import Data.Time
 import Data.Maybe
@@ -10,11 +26,22 @@ import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.MyText (Text,pack,unpack)
 import Data.Function (on)
+#if MIN_VERSION_time(1,5,0)
+import Data.Time.Format(defaultTimeLocale)
+#else
 import System.Locale (defaultTimeLocale)
-
+#endif
+import Control.Applicative
+import Data.Strict ((:!:), Pair(..))
+import qualified Data.Strict as Strict
+import Data.Traversable (sequenceA)
+import Control.Arrow
+import Debug.Trace
 
 import Data
 import Categorize
+import LeftFold
+import DumpFormat
 
 
 data Report = GeneralInfos
@@ -23,6 +50,7 @@ data Report = GeneralInfos
     | EachCategory
     | IntervalCategory Category
     | IntervalTag Activity
+    | DumpSamples
         deriving (Show, Eq)
 
 data Filter = Exclude ActivityMatcher | Only ActivityMatcher | GeneralCond String
@@ -31,6 +59,12 @@ data Filter = Exclude ActivityMatcher | Only ActivityMatcher | GeneralCond Strin
 data ActivityMatcher = MatchActivity Activity | MatchCategory Category
         deriving (Show, Eq)
 
+data ActivityFilter = ExcludeActivity ActivityMatcher | OnlyActivity ActivityMatcher
+        deriving (Show, Eq)
+
+data Repeater = ByMinute | ByHour | ByDay | ByMonth | ByYear
+        deriving (Show, Eq)
+
 -- Supported report output formats: text, comma-separated values and
 -- tab-separated values
 data ReportFormat = RFText | RFCSV | RFTSV
@@ -39,42 +73,49 @@ data ReportFormat = RFText | RFCSV | RFTSV
 data ReportOptions = ReportOptions
     { roMinPercentage :: Double
     , roReportFormat :: ReportFormat
+    , roActivityFilter :: [ActivityFilter]
     }
         deriving (Show, Eq)
 
+defaultReportOptions :: ReportOptions
 defaultReportOptions = ReportOptions
     { roMinPercentage = 1
     , roReportFormat = RFText
+    , roActivityFilter = []
     }
 
 -- Data format semantically representing the result of a report, including the
 -- title
+type Interval = (String,String,String,String) 
 data ReportResults =
         ListOfFields String [(String, String)]
         | ListOfTimePercValues String [(String, String, Double)]
         | PieChartOfTimePercValues  String [(String, String, Double)]
-        | ListOfIntervals String [(String,String,String,String)]
+        | ListOfIntervals String [Interval]
+        | MultipleReportResults [ReportResults]
+        | RepeatedReportResults String [(String, ReportResults)]
+        | DumpResult (TimeLog (CaptureData, TimeZone, ActivityData))
 
 
--- 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 ->
+filterPredicate :: [Filter] -> TimeLogEntry (Ctx, ActivityData) -> Bool
+filterPredicate filters tl = 
        all (\flag -> case flag of 
                 Exclude act  -> excludeTag act tl
                 Only act     -> onlyTag act tl
-                GeneralCond s-> applyCond s tl) filters
-
-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)
+                GeneralCond s-> applyCond s (cTimeZone (fst (tlData tl))) tl) filters
+
+filterActivity :: [ActivityFilter] -> ActivityData -> ActivityData
+filterActivity fs = filter (applyActivityFilter fs)
+
+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 matcher = not . any (matchActivityMatcher matcher) . snd . tlData
 onlyTag matcher = any (matchActivityMatcher matcher) . snd . tlData
+
+defaultFilter :: Filter
 defaultFilter = Exclude (MatchActivity inactiveActivity)
 
 matchActivityMatcher :: ActivityMatcher -> Activity -> Bool
@@ -97,74 +138,158 @@ data Calculations = Calculations
         , fractionSel :: Double
         , fractionSelRec :: Double
         , sums :: M.Map Activity NominalDiffTime
-        , allTags :: TimeLog (Ctx, ActivityData)
+        -- , allTags :: TimeLog (Ctx, ActivityData)
         -- tags is a list of uninterrupted entries
-        , tags :: [TimeLog (Ctx, ActivityData)]
+        -- , tags :: [TimeLog (Ctx, ActivityData)]
         }
 
-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 (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 (concat tags)
-          , allTags
-          , tags
-          } in c
-
--- | Sums up each occurence of an 'Activity', weighted by the sampling rate
-sumUp :: TimeLog (Ctx, ActivityData) -> M.Map Activity NominalDiffTime
-sumUp = foldr go M.empty
-  where go tl m = foldr go' m (snd (tlData tl))
-          where go' act = M.insertWith (+) act (fromInteger (tlRate tl)/1000)
-
-
-listCategories :: TimeLog (Ctx, ActivityData) -> [Category]
-listCategories = S.toList . foldr go S.empty
-  where go tl m = foldr go' m (snd (tlData tl))
-          where go' (Activity (Just cat) _) = S.insert cat
-                go' _                       = id
-
-putReports :: ReportOptions -> Calculations -> [Report] -> IO ()
-putReports opts c = sequence_ . intersperse (putStrLn "") . map (putReport opts 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 :: ReportOptions -> Calculations -> Report -> ReportResults
-reportToTable opts (Calculations {..}) r = case r of
-        GeneralInfos -> ListOfFields "General Information" $
-                [ ("FirstRecord", show firstDate)
-                , ("LastRecord",  show lastDate)
-                , ("Number of records", show (length allTags))
-                , ("Total time recorded",  showTimeDiff totalTimeRec)
-                , ("Total time selected",  showTimeDiff totalTimeSel)
-                , ("Fraction of total time recorded", printf "%3.0f%%" (fractionRec * 100))
-                , ("Fraction of total time selected", printf "%3.0f%%" (fractionSel * 100))
-                , ("Fraction of recorded time selected", printf "%3.0f%%" (fractionSelRec * 100))
-                ]
-
-        TotalTime -> ListOfTimePercValues "Total time per tag" $
-                mapMaybe (\(tag,time) ->
-                      let perc = realToFrac time/realToFrac totalTimeSel in
-                      if perc*100 >= roMinPercentage opts
-                      then Just $ ( show tag
-                                  , showTimeDiff time
-                                  , perc)
-                      else Nothing
-                      ) $
-                reverse $
-                sortBy (comparing snd) $
-                M.toList sums
-        
-        Category cat -> PieChartOfTimePercValues ("Statistics for category " ++ show cat) $
+prepareCalculations :: LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) Calculations
+prepareCalculations =
+    pure (\fd ld ttr tts s -> 
+        let c = Calculations
+                  { firstDate = fd
+                  , lastDate = ld
+                  , timeDiff = diffUTCTime (lastDate c) (firstDate c)
+                  , totalTimeRec = ttr
+                  , totalTimeSel = tts
+                  , fractionRec = realToFrac (totalTimeRec c) / (realToFrac (timeDiff c))
+                  , fractionSel = realToFrac (totalTimeSel c) / (realToFrac (timeDiff c))
+                  , fractionSelRec = realToFrac (totalTimeSel c) / realToFrac (totalTimeRec c)
+                  , sums = s
+                  } in c) <*>
+    onAll calcFirstDate <*>
+    onAll calcLastDate <*>
+    onAll calcTotalTime <*>
+    onSelected calcTotalTime <*>
+    onSelected calcSums 
+  where
+
+calcFirstDate :: LeftFold (TimeLogEntry a) UTCTime
+calcFirstDate = fromJust <$> lfFirst `mapElems` tlTime
+
+calcLastDate :: LeftFold (TimeLogEntry a) UTCTime
+calcLastDate = fromJust <$> lfLast `mapElems` tlTime
+
+calcTotalTime :: LeftFold (TimeLogEntry a) NominalDiffTime
+calcTotalTime = (/1000) <$> LeftFold 0 (+) fromInteger `mapElems` tlRate
+
+calcSums :: LeftFold (TimeLogEntry (a, [Activity])) (M.Map Activity NominalDiffTime)
+calcSums = LeftFold M.empty
+            (\m tl ->
+                let go' m act = M.insertWith' (+) act (fromInteger (tlRate tl)/1000) m
+                in foldl' go' m (snd (tlData tl))) id
+
+processRepeater :: TimeZone -> Repeater -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults
+processRepeater tz r rep = case repeaterImpl r of
+    RepeaterImpl catR showR ->
+        filterElems (\(b :!: _) -> b) $
+        pure (RepeatedReportResults (repeaterTitle r) . map (first showR) . M.toList) <*>
+        multiplex (catR . utcToLocalTime tz . tlTime . Strict.snd) rep
+
+data RepeaterImpl where
+  RepeaterImpl :: Ord r => (LocalTime -> r) -> (r -> String) -> RepeaterImpl
+
+repeaterTitle :: Repeater -> String
+repeaterTitle ByMinute = "Minute"
+repeaterTitle ByHour   = "Hour"
+repeaterTitle ByDay    = "Day"
+repeaterTitle ByMonth  = "Month"
+repeaterTitle ByYear   = "Year"
+
+repeaterImpl :: Repeater -> RepeaterImpl
+repeaterImpl ByMinute = RepeaterImpl
+    -- a somewhat lazy implementations, using strings...
+    (formatTime defaultTimeLocale "%F %H:%M")
+    id
+repeaterImpl ByHour = RepeaterImpl
+    (formatTime defaultTimeLocale "%F %H:00")
+    id
+repeaterImpl ByDay = RepeaterImpl
+    localDay
+    showGregorian
+repeaterImpl ByMonth = RepeaterImpl
+    ((\(y,m,_) -> (y, m)) . toGregorian . localDay)
+    (\(y,m) -> show y ++ "-" ++ show m)
+repeaterImpl ByYear = RepeaterImpl
+    ((\(y,_,_) -> y) . toGregorian . localDay)
+    show
+
+processReport :: ReportOptions -> Report -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults
+processReport opts GeneralInfos =
+   pure (\n firstDate lastDate ttr tts ->
+    let timeDiff = diffUTCTime lastDate firstDate
+        fractionRec = realToFrac ttr / (realToFrac timeDiff) :: Double
+        fractionSel = realToFrac tts / (realToFrac timeDiff) :: Double
+        fractionSelRec = realToFrac tts / realToFrac ttr :: Double
+    in ListOfFields "General Information"
+        [ ("FirstRecord", show firstDate)
+        , ("LastRecord",  show lastDate)
+        , ("Number of records", show n)
+        , ("Total time recorded",  showTimeDiff opts ttr)
+        , ("Total time selected",  showTimeDiff opts tts)
+        , ("Fraction of total time recorded", printf "%3.0f%%" (fractionRec * 100))
+        , ("Fraction of total time selected", printf "%3.0f%%" (fractionSel * 100))
+        , ("Fraction of recorded time selected", printf "%3.0f%%" (fractionSelRec * 100))
+        ]) <*>
+    onAll lfLength <*>
+    onAll calcFirstDate <*>
+    onAll calcLastDate <*>
+    onAll calcTotalTime <*>
+    onSelected calcTotalTime
+
+processReport opts  TotalTime =
+    onSelected $
+        pure (\totalTimeSel sums -> 
+            ListOfTimePercValues "Total time per tag" .
+            mapMaybe (\(tag,time) ->
+                  let perc = realToFrac time/realToFrac totalTimeSel
+                      pick = applyActivityFilter (roActivityFilter opts) tag
+                  in if pick && perc*100 >= roMinPercentage opts
+                  then Just $ ( show tag
+                              , showTimeDiff opts time
+                              , perc)
+                  else Nothing
+                  ) .
+            reverse .
+            sortBy (comparing snd) $
+            M.toList $
+            sums) <*>
+    calcTotalTime <*>
+    calcSums 
+
+processReport opts (Category cat) = pure (\c -> processCategoryReport opts c cat) <*>
+    prepareCalculations
+
+processReport opts EachCategory = 
+    pure (\c cats -> MultipleReportResults $ map (processCategoryReport opts c) cats) <*>
+    prepareCalculations <*>
+    onSelected calcCategories
+
+processReport opts (IntervalCategory cat) =
+    processIntervalReport opts ("Intervals for category " ++ show cat) (extractCat cat) 
+    where
+        extractCat :: Category -> ActivityData -> Maybe String
+        extractCat cat = fmap (unpack . activityName) . listToMaybe . filter ( (==Just cat) . activityCategory )
+
+processReport opts (IntervalTag tag) =
+    processIntervalReport opts ("Intervals for category " ++ show tag) (extractTag tag) 
+    where
+        extractTag :: Activity -> ActivityData -> Maybe String
+        extractTag tag = fmap show . listToMaybe . filter ( (==tag) )
+
+processReport opts DumpSamples =
+    DumpResult <$> onSelected (mapElems toList $ fmap $
+        \(cd,ad) -> (tlData (cNow cd), cTimeZone cd, filterActivity (roActivityFilter opts) ad)
+        )
+
+calcCategories :: LeftFold (TimeLogEntry (Ctx, ActivityData)) [Category]
+calcCategories = fmap S.toList $ leftFold S.empty $ \s tl ->
+    foldl' go' s (snd (tlData tl))
+          where go' s (Activity (Just cat) _) = S.insert cat s
+                go' s _                       = s
+
+processCategoryReport opts ~(Calculations {..}) 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 < roMinPercentage opts) filteredSums
@@ -172,10 +297,11 @@ reportToTable opts (Calculations {..}) r = case r of
                 in
 
                 mapMaybe (\(tag,time) ->
-                      let perc = realToFrac time/realToFrac totalTimeSel in
-                      if perc*100 >= roMinPercentage opts
+                      let perc = realToFrac time/realToFrac totalTimeSel
+                          pick = applyActivityFilter (roActivityFilter opts) tag
+                      in if pick && perc*100 >= roMinPercentage opts
                       then Just ( show tag
-                                , showTimeDiff time
+                                , showTimeDiff opts time
                                 , perc)
                       else Nothing
                       )
@@ -184,7 +310,7 @@ reportToTable opts (Calculations {..}) r = case r of
                 (
                 if tooSmallTimes > 0
                 then [( printf "(%d entries omitted)" (M.size tooSmallSums)
-                      , showTimeDiff tooSmallTimes
+                      , showTimeDiff opts tooSmallTimes
                       , realToFrac tooSmallTimes/realToFrac totalTimeSel
                       )]
                 else []
@@ -192,63 +318,97 @@ reportToTable opts (Calculations {..}) r = case r of
                 ++      
                 (if uncategorizedTime > 0
                 then [( "(unmatched time)"
-                      , showTimeDiff uncategorizedTime
+                      , showTimeDiff opts uncategorizedTime
                       , realToFrac uncategorizedTime/realToFrac totalTimeSel
                       )]
                 else []
                 )
-        
-        IntervalCategory cat -> intervalReportToTable ("Intervals for category " ++ show cat)
-                                                      (extractCat cat) 
-        IntervalTag tag -> intervalReportToTable ("Intervals for category " ++ show tag)
-                                                 (extractTag tag) 
 
-    where
-        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) )
+tlRateTimediff :: TimeLogEntry a -> NominalDiffTime
+tlRateTimediff tle = fromIntegral (tlRate tle) / 1000
+
+processIntervalReport :: ReportOptions -> String -> (ActivityData -> Maybe String) -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults
+processIntervalReport opts title extr = runOnIntervals  go1 go2
+  where
+    go1 :: LeftFold (TimeLogEntry (Ctx, ActivityData)) [Interval]
+    go1 = go3 `mapElems` fmap (extr . snd) 
+    go3 :: LeftFold (TimeLogEntry (Maybe String)) [Interval]
+    go3 = runOnGroups sameGroup go4 (onJusts toList)
+    sameGroup tl1 tl2 =
+        tlData tl1 == tlData tl2
+         && tlTime tl2 `diffUTCTime` tlTime tl1 < 2 * tlRateTimediff tl1
+    go4 :: LeftFold (TimeLogEntry (Maybe String)) (Maybe Interval)
+    go4 = pure (\fe le ->
+        case tlData fe of
+            Just str -> Just
+                ( str
+                , showUtcTime (tlTime fe)
+                , showUtcTime (tlRateTimediff le `addUTCTime` tlTime le)
+                , showTimeDiff opts $
+                    tlTime le `diffUTCTime` tlTime fe + tlRateTimediff le
+                )
+            Nothing -> Nothing) <*>
+        (fromJust <$> lfFirst) <*>
+        (fromJust <$> lfLast)
+    go2 :: LeftFold [Interval] ReportResults
+    go2 = ListOfIntervals title <$> concatFold
+        
 
-        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
-            
+{-
+        ((extr. snd) `filterWith` 
+            runOnIntervals
+                (runOnGroups ((==) `on` tlData)
+-}
+
+
+{-
+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
-
+renderReport :: ReportOptions -> ReportResults -> IO ()
+renderReport opts (DumpResult samples) =
+    dumpActivity samples
+renderReport opts (MultipleReportResults reports) =
+    sequence_ . intersperse (putStrLn "") . map (renderReport opts) $ reports
+renderReport opts reportdata =
+    putStr $ doRender opts reportdata
+
+doRender :: ReportOptions -> ReportResults -> String
 doRender opts reportdata = case roReportFormat opts of
-                RFText -> renderReportText reportdata
-                RFCSV -> renderReportCSV reportdata
-                RFTSV -> renderReportTSV reportdata
+                RFText -> renderReportText id reportdata
+                RFCSV -> renderWithDelimiter "," $ renderXSV reportdata
+                RFTSV -> renderWithDelimiter "\t" $ renderXSV reportdata
 
-renderReportText (ListOfFields title dats) = 
-    underline title ++
+renderReportText titleMod (ListOfFields title dats) = 
+    underline (titleMod title) ++
     (tabulate False $ map (\(f,v) -> [f,v]) dats)
 
-renderReportText (ListOfTimePercValues title dats) = 
-    underline title ++ (tabulate True $ listOfValues dats)
+renderReportText titleMod (ListOfTimePercValues title dats) = 
+    underline (titleMod title) ++ (tabulate True $ listOfValues dats)
 
-renderReportText (PieChartOfTimePercValues title dats) = 
-    underline title ++ (tabulate True $ piechartOfValues dats)
+renderReportText titleMod (PieChartOfTimePercValues title dats) = 
+    underline (titleMod title) ++ (tabulate True $ piechartOfValues dats)
 
-renderReportText (ListOfIntervals title dats) = 
-    underline title ++ (tabulate True $ listOfIntervals dats)
+renderReportText titleMod (ListOfIntervals title dats) = 
+    underline (titleMod title) ++ (tabulate True $ listOfIntervals dats)
+
+renderReportText titleMod (RepeatedReportResults cat reps) = 
+    intercalate "\n" $ map (\(v,rr) -> renderReportText (titleMod . mod v) rr) reps
+  where mod v s = s ++ " (" ++ cat ++ " " ++ v ++ ")"
 
 listOfValues dats =
     ["Tag","Time","Percentage"] :
@@ -264,36 +424,24 @@ listOfIntervals dats =
 
 -- The reporting of "General Information" is not supported for the
 -- comma-separated output format.
-renderReportCSV (ListOfFields title dats) = 
-    error ("\"" ++ title ++ "\"" ++ " not supported for comma-separated output format")
-
-renderReportCSV (ListOfTimePercValues _ dats) = 
-    renderWithDelimiter "," (listOfValues dats)
-
-renderReportCSV (PieChartOfTimePercValues _ dats) = 
-    renderWithDelimiter "," (piechartOfValues dats)
+renderXSV (ListOfFields title dats) = 
+    error ("\"" ++ title ++ "\"" ++ " not supported for this output format")
 
-renderReportCSV (ListOfIntervals title dats) = 
-    renderWithDelimiter "," (listOfIntervals dats)
+renderXSV (ListOfTimePercValues _ dats) = listOfValues dats
 
--- The reporting of "General Information" is not supported for the
--- TAB-separated output format.
-renderReportTSV (ListOfFields title dats) = 
-    error ("\"" ++ title ++ "\"" ++ " not supported for TAB-separated output format")
-
-renderReportTSV (ListOfTimePercValues _ dats) = 
-    renderWithDelimiter "\t" (listOfValues dats)
+renderXSV (PieChartOfTimePercValues _ dats) = piechartOfValues dats
 
-renderReportTSV (PieChartOfTimePercValues _ dats) = 
-    renderWithDelimiter "\t" (piechartOfValues dats)
+renderXSV (ListOfIntervals title dats) = listOfIntervals dats
 
-renderReportTSV (ListOfIntervals title dats) = 
-    renderWithDelimiter "\t" (listOfIntervals dats)
+-- A bit code-smelly here.
+renderXSV (RepeatedReportResults cat reps) = title : fields
+  where
+    title = cat : head (renderXSV (snd (head reps)))
+    fields = concatMap (\(v,rr) -> map (v:) (tail (renderXSV rr))) reps
 
+renderWithDelimiter :: String -> [[String]] -> String
 renderWithDelimiter delim datasource =
-    unlines $ map (injectDelimiter delim) datasource
-
-injectDelimiter d = concat . intersperse d
+    unlines $ map (intercalate delim) datasource
 
 tabulate :: Bool -> [[String]] -> String
 tabulate titlerow rows = unlines $ addTitleRow $ map (intercalate " | " . zipWith (\l s -> take (l - length s) (repeat ' ') ++ s) colwidths) rows
@@ -304,8 +452,12 @@ tabulate titlerow rows = unlines $ addTitleRow $ map (intercalate " | " . zipWit
                  -- | titlerow  = \(l:ls) -> l : (take (length l) (repeat '-')) : ls
                     | otherwise = id
 
-showTimeDiff :: NominalDiffTime -> String
-showTimeDiff t = go False $ zip [days,hours,mins,secs] ["d","h","m","s"]
+showTimeDiff :: ReportOptions -> NominalDiffTime -> String
+showTimeDiff (ReportOptions { roReportFormat = RFText }) = showTimeDiffHuman
+showTimeDiff _                                           = showTimeDiffMachine
+
+showTimeDiffHuman :: NominalDiffTime -> String
+showTimeDiffHuman t = go False $ zip [days,hours,mins,secs] ["d","h","m","s"]
   where s = round t :: Integer
         days  =  s `div` (24*60*60)
         hours = (s `div` (60*60)) `mod` 24
@@ -318,9 +470,17 @@ showTimeDiff t = go False $ zip [days,hours,mins,secs] ["d","h","m","s"]
         go False ((a,u):vs) | a > 0     = printf "%2d%s" a u ++ go True vs
                             | otherwise =                       go False vs
 
+showTimeDiffMachine :: NominalDiffTime -> String
+showTimeDiffMachine t = printf "%d:%02d:%02d" hours mins secs
+  where s = round t :: Integer
+        hours = s `div` (60*60)
+        mins  = (s `div` 60) `mod` 60
+        secs  =  s `mod` 60 
+
 showUtcTime :: UTCTime -> String
 showUtcTime = formatTime defaultTimeLocale "%x %X"
 
+underline :: String -> String
 underline str = unlines 
     [ str
     , map (const '=') str