Interval report: Correctly split intervals when no data came in
authorJoachim Breitner <mail@joachim-breitner.de>
Mon, 21 Sep 2015 18:35:39 +0000 (18:35 +0000)
committerJoachim Breitner <mail@joachim-breitner.de>
Mon, 21 Sep 2015 18:35:39 +0000 (18:35 +0000)
this fixes #29, and it seems it also fixes #30.

src/LeftFold.hs
src/Stats.hs
tests/gap-handling.out

index 7e24d4b..2da5433 100644 (file)
@@ -73,13 +73,13 @@ runOnGroups :: (x -> x -> Bool) -> LeftFold x y -> LeftFold y z -> LeftFold x z
 runOnGroups eq _ (Pure ox) = Pure ox
 runOnGroups eq (Pure ix) (LeftFold sto po fo) = LeftFold (S.Nothing :!: sto) go finish 
     where go (S.Nothing :!: so) x             = (S.Just x :!: so)
-          go (S.Just x' :!: so) x | x `eq` x' = (S.Just x :!: so)
+          go (S.Just x' :!: so) x | x' `eq` x = (S.Just x :!: so)
                                   | otherwise = (S.Just x :!: po so ix)
           finish (S.Nothing :!: so) = fo so
           finish (S.Just _  :!: so) = fo (po so ix)
 runOnGroups eq (LeftFold sti pi fi) (LeftFold sto po fo) = LeftFold (S.Nothing :!: sti :!: sto) go finish 
     where go (S.Nothing :!: si :!: so) x             = (S.Just x :!: pi si x  :!: so)
-          go (S.Just x' :!: si :!: so) x | x `eq` x' = (S.Just x :!: pi si x  :!: so)
+          go (S.Just x' :!: si :!: so) x | x' `eq` x = (S.Just x :!: pi si x  :!: so)
                                          | otherwise = (S.Just x :!: pi sti x :!: po so (fi si))
           finish (S.Nothing :!: si :!: so) = fo so
           finish (S.Just _  :!: si :!: so) = fo (po so (fi si))
index 52d337d..c79968a 100644 (file)
@@ -36,6 +36,7 @@ import Data.Strict ((:!:), Pair(..))
 import qualified Data.Strict as Strict
 import Data.Traversable (sequenceA)
 import Control.Arrow
+import Debug.Trace
 
 import Data
 import Categorize
@@ -323,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 ((fromIntegral (tlRate le) / 1000) `addUTCTime` 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) <*>
index dbc2e21..52c3f77 100644 (file)
@@ -1,10 +1,11 @@
-Intervals for category "Program"                                                                                                                  
+Intervals for category "Program"
 ================================
 __________________Tag_|______________From_|_____________Until_|_Duration_
-gnome-terminal-server | 09/20/15 14:24:03 | 09/20/15 14:25:12 |    1m19s
-            Navigator | 09/20/15 14:25:22 | 09/20/15 14:26:12 |      50s
-            Navigator | 09/20/15 14:49:31 | 09/20/15 14:55:31 |    6m10s
-gnome-terminal-server | 09/20/15 14:55:41 | 09/20/15 14:56:21 |      40s
-gnome-terminal-server | 09/20/15 18:51:47 | 09/20/15 18:52:07 |      30s
-            Navigator | 09/20/15 18:52:17 | 09/20/15 18:53:45 |    1m38s
-gnome-terminal-server | 09/20/15 18:53:55 | 09/20/15 18:54:15 |      30s
+gnome-terminal-server | 09/20/15 14:24:03 | 09/20/15 14:25:22 |    1m19s
+            Navigator | 09/20/15 14:25:22 | 09/20/15 14:26:22 |    1m00s
+            Navigator | 09/20/15 14:49:31 | 09/20/15 14:55:41 |    6m10s
+gnome-terminal-server | 09/20/15 14:55:41 | 09/20/15 14:56:31 |      50s
+gnome-terminal-server | 09/20/15 18:51:47 | 09/20/15 18:52:17 |      30s
+            Navigator | 09/20/15 18:52:17 | 09/20/15 18:52:37 |      20s
+            Navigator | 09/20/15 18:53:15 | 09/20/15 18:53:55 |      40s
+gnome-terminal-server | 09/20/15 18:53:55 | 09/20/15 18:54:25 |      30s