Interval report: Correctly split intervals when no data came in
[darcs-mirror-arbtt.git] / src / Stats.hs
index e65de62..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
@@ -8,42 +24,107 @@ import Data.Ord
 import Text.Printf
 import qualified Data.Map as M
 import qualified Data.Set as S
-import Data.MyText (Text)
+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 | TotalTime | Category Text | EachCategory
+data Report = GeneralInfos
+    | TotalTime
+    | Category Category
+    | EachCategory
+    | IntervalCategory Category
+    | IntervalTag Activity
+    | DumpSamples
         deriving (Show, Eq)
 
-data Filter = Exclude Activity | Only Activity | AlsoInactive | GeneralCond String
+data Filter = Exclude ActivityMatcher | Only ActivityMatcher | GeneralCond String
         deriving (Show, Eq)
 
-data ReportOption = MinPercentage Double
+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
+        deriving (Show, Eq)
+
+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 [Interval]
+        | MultipleReportResults [ReportResults]
+        | RepeatedReportResults String [(String, ReportResults)]
+        | DumpResult (TimeLog (CaptureData, TimeZone, ActivityData))
+
+
+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 (cTimeZone (fst (tlData tl))) tl) filters
 
+filterActivity :: [ActivityFilter] -> ActivityData -> ActivityData
+filterActivity fs = filter (applyActivityFilter fs)
 
-applyFilters :: [Filter] -> TimeLog (Ctx, ActivityData) -> TimeLog (Ctx, ActivityData)
-applyFilters filters tle = 
-        foldr (\flag -> case flag of 
-                                Exclude act  -> excludeTag act
-                                Only act     -> onlyTag act
-                                AlsoInactive -> id
-                                GeneralCond s-> applyCond s 
-        ) (if AlsoInactive `elem` filters then tle else defaultFilter tle) filters
+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)
 
-excludeTag act = filter (notElem act . snd . tlData)
-onlyTag act = filter (elem act . snd . tlData)
-defaultFilter = excludeTag inactiveActivity
+matchActivityMatcher :: ActivityMatcher -> Activity -> Bool
+matchActivityMatcher (MatchActivity act1) act2 = act1 == act2
+matchActivityMatcher (MatchCategory cat) act2 = Just cat == activityCategory act2
+
+parseActivityMatcher :: String -> ActivityMatcher 
+parseActivityMatcher str | last str == ':' = MatchCategory (pack (init str))
+                         | otherwise       = MatchActivity (read str)
 
 -- | to be used lazily, to re-use computation when generating more than one
 -- report at a time
@@ -57,84 +138,170 @@ data Calculations = Calculations
         , fractionSel :: Double
         , fractionSelRec :: Double
         , sums :: M.Map Activity NominalDiffTime
-        , allTags :: TimeLog (Ctx, ActivityData)
-        , tags :: TimeLog (Ctx, ActivityData)
+        -- , allTags :: TimeLog (Ctx, ActivityData)
+        -- tags is a list of uninterrupted entries
+        -- , 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 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 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 :: [ReportOption] -> Calculations -> [Report] -> IO ()
-putReports opts c = sequence_ . intersperse (putStrLn "") . map (putReport opts c) 
-
-putReport :: [ReportOption] -> Calculations -> Report -> IO ()
-putReport opts c EachCategory = putReports opts c (map Category (listCategories (tags c)))
-putReport opts c r = renderReport $ reportToTable opts c r
-
-reportToTable :: [ReportOption] -> 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 >= minPercentage
-                      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 < minPercentage) filteredSums
+                    tooSmallSums = M.filter (\t -> realToFrac t / realToFrac totalTimeSel * 100 < roMinPercentage opts) filteredSums
                     tooSmallTimes = M.fold (+) 0 tooSmallSums
                 in
 
                 mapMaybe (\(tag,time) ->
-                      let perc = realToFrac time/realToFrac totalTimeSel in
-                      if perc*100 >= minPercentage
+                      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
                       )
@@ -143,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 []
@@ -151,27 +318,130 @@ reportToTable opts (Calculations {..}) r = case r of
                 ++      
                 (if uncategorizedTime > 0
                 then [( "(unmatched time)"
-                      , showTimeDiff uncategorizedTime
+                      , showTimeDiff opts uncategorizedTime
                       , realToFrac uncategorizedTime/realToFrac totalTimeSel
                       )]
                 else []
                 )
 
-  where minPercentage = last $ mapMaybe (\f -> case f of {MinPercentage m -> Just m {- ; _ -> Nothing -} }) opts
+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
+        
+
+{-
+        ((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 :: 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 id reportdata
+                RFCSV -> renderWithDelimiter "," $ renderXSV reportdata
+                RFTSV -> renderWithDelimiter "\t" $ renderXSV reportdata
+
+renderReportText titleMod (ListOfFields title dats) = 
+    underline (titleMod title) ++
+    (tabulate False $ map (\(f,v) -> [f,v]) dats)
+
+renderReportText titleMod (ListOfTimePercValues title dats) = 
+    underline (titleMod title) ++ (tabulate True $ listOfValues dats)
 
+renderReportText titleMod (PieChartOfTimePercValues title dats) = 
+    underline (titleMod title) ++ (tabulate True $ piechartOfValues dats)
 
-renderReport (ListOfFields title dats) = do
-        putStrLnUnderlined title
-        putStr $ tabulate False $ map (\(f,v) -> [f,v]) dats
+renderReportText titleMod (ListOfIntervals title dats) = 
+    underline (titleMod title) ++ (tabulate True $ listOfIntervals dats)
 
-renderReport (ListOfTimePercValues title dats) = do
-        putStrLnUnderlined title
-        putStr $ tabulate True $ ["Tag","Time","Percentage"] : map (\(f,t,p) -> [f,t,printf "%.2f" (p*100)]) dats
+renderReportText titleMod (RepeatedReportResults cat reps) = 
+    intercalate "\n" $ map (\(v,rr) -> renderReportText (titleMod . mod v) rr) reps
+  where mod v s = s ++ " (" ++ cat ++ " " ++ v ++ ")"
 
-renderReport (PieChartOfTimePercValues title dats) = do
-        putStrLnUnderlined title
-        putStr $ tabulate True $ ["Tag","Time","Percentage"] : map (\(f,t,p) -> [f,t,printf "%.2f" (p*100)]) dats
+listOfValues dats =
+    ["Tag","Time","Percentage"] :
+    map (\(f,t,p) -> [f,t,printf "%.2f" (p*100)]) dats
 
+piechartOfValues dats =
+    ["Tag","Time","Percentage"] :
+    map (\(f,t,p) -> [f,t,printf "%.2f" (p*100)]) dats
+
+listOfIntervals dats =
+    ["Tag","From","Until","Duration"] :
+    map (\(t,f,u,d) -> [t,f,u,d]) dats
+
+-- The reporting of "General Information" is not supported for the
+-- comma-separated output format.
+renderXSV (ListOfFields title dats) = 
+    error ("\"" ++ title ++ "\"" ++ " not supported for this output format")
+
+renderXSV (ListOfTimePercValues _ dats) = listOfValues dats
+
+renderXSV (PieChartOfTimePercValues _ dats) = piechartOfValues dats
+
+renderXSV (ListOfIntervals title dats) = 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 (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
@@ -182,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
@@ -196,6 +470,18 @@ 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
 
-putStrLnUnderlined str = do
-        putStrLn str
-        putStrLn $ map (const '=') str
+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
+    ]