Interval report: Correctly split intervals when no data came in
[darcs-mirror-arbtt.git] / src / Stats.hs
index c38fb46..c79968a 100644 (file)
@@ -1,4 +1,4 @@
-{-# LANGUAGE RecordWildCards, NamedFieldPuns, TypeOperators, TupleSections, GADTSyntax, ExistentialQuantification #-}
+{-# LANGUAGE RecordWildCards, NamedFieldPuns, TypeOperators, TupleSections, GADTSyntax, ExistentialQuantification, CPP #-}
 module Stats (
     Report(..),
     ReportOptions(..),
@@ -26,12 +26,17 @@ 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
@@ -174,15 +179,22 @@ calcSums = LeftFold M.empty
                 let go' m act = M.insertWith' (+) act (fromInteger (tlRate tl)/1000) m
                 in foldl' go' m (snd (tlData tl))) id
 
-processRepeater :: Repeater -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults
-processRepeater r rep = case repeaterImpl r of
+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 "Day" . map (first showR) . M.toList) <*>
-        multiplex (catR . tlTime . Strict.snd) rep
+        pure (RepeatedReportResults (repeaterTitle r) . map (first showR) . M.toList) <*>
+        multiplex (catR . utcToLocalTime tz . tlTime . Strict.snd) rep
 
 data RepeaterImpl where
-  RepeaterImpl :: Ord r => (UTCTime -> r) -> (r -> String) -> RepeaterImpl
+  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
@@ -190,16 +202,16 @@ repeaterImpl ByMinute = RepeaterImpl
     (formatTime defaultTimeLocale "%F %H:%M")
     id
 repeaterImpl ByHour = RepeaterImpl
-    (formatTime defaultTimeLocale "%F %H")
+    (formatTime defaultTimeLocale "%F %H:00")
     id
 repeaterImpl ByDay = RepeaterImpl
-    utctDay
+    localDay
     showGregorian
 repeaterImpl ByMonth = RepeaterImpl
-    ((\(y,m,_) -> (y, m)) . toGregorian . utctDay)
+    ((\(y,m,_) -> (y, m)) . toGregorian . localDay)
     (\(y,m) -> show y ++ "-" ++ show m)
 repeaterImpl ByYear = RepeaterImpl
-    ((\(y,_,_) -> y) . toGregorian . utctDay)
+    ((\(y,_,_) -> y) . toGregorian . localDay)
     show
 
 processReport :: ReportOptions -> Report -> LeftFold (Bool :!: TimeLogEntry (Ctx, ActivityData)) ReportResults
@@ -312,22 +324,28 @@ processCategoryReport opts ~(Calculations {..}) cat =
                 else []
                 )
 
+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 ((==) `on` tlData) go4 (onJusts toList)
+    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 (tlTime le)
+                , showUtcTime (tlRateTimediff le `addUTCTime` tlTime le)
                 , showTimeDiff opts $
-                    tlTime le `diffUTCTime` tlTime fe + fromIntegral (tlRate fe)/1000
+                    tlTime le `diffUTCTime` tlTime fe + tlRateTimediff le
                 )
             Nothing -> Nothing) <*>
         (fromJust <$> lfFirst) <*>