Make log reduction safer in presence of overlapping events.

[?]

Apr 23, 2015, 4:28 AM

SCXG6TJWYIPRUMT27KGKIIF6FYKTUTY74UNZ2FQTT63XZ6HIF3AAC

Dependencies

[2] 5DRIWGLU Improving TimeLog specs
[3] SLL7262C Make depreciation functions more flexible.
[4] Y35QCWYW Minor improvement in WorkIndex type to eliminate duplicated information.
[5] EZQG2APB Update task list.
[6] EQXRXRZD Changed to use tasty instead of test-framework
[7] 4QX5E5AC Initial compilation of payouts function succeeds.
[8] 2KZPOGRB Once you get Haskell to compile, the tests pass!
[9] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
[10] 7XN3I3QJ Add 'loggedIntervals' endpoint.
[11] A6HKMINB Attempting to improve JSON handling.
[12] NMWWP4ZN Trying out Hspec
[13] A2J7B4SC Initial impl of depreciation function.
[14] GKGVYBZG Added JSON serialization to TimeLog
[15] TLQ72DSJ Lenses, sqlite-simple
[16] 7KZP4RHZ Switch from Data.Time to Data.Thyme
[17] N4NDAZYT Initial implementation of payouts.
[18] RSEB2NFG Replacing Snap with Scotty.
[19] Z7KS5XHH Very WIP. Wow.
[20] JUUMYIQE Add groupBy utility function for use in TimeLog.
[21] NVOCQVAS Initial failing tests.
[22] 2OIPAQCB Merge branch 'master' of github.com:nuttycom/ananke
[23] EMVTF2IW WIP moving back to snap.
[24] 7DBNV3GV Initial, stack-based impl of time log event reduction.

Change contents

replacement in lib/Quixotic/Interval.hs at line 4

[3.5263]→[3.3:44](∅→∅),[3.1447]→[3.3:44](∅→∅)

( Interval, interval, start, end, ilen

[3.5263]

[3.3192]

( Interval(Interval), interval, start, end, ilen
edit in lib/Quixotic/Interval.hs at line 6

[3.3228]

[3.1483]

, containsInclusive
replacement in lib/Quixotic/Interval.hs at line 21

[3.635]→[3.1634:1681](∅→∅),[3.1839]→[3.1634:1681](∅→∅),[3.1634]→[3.1634:1681](∅→∅)

} deriving (Show, Eq)

[3.635]

[3.1840]

} deriving (Show, Eq, Ord)
edit in lib/Quixotic/Interval.hs at line 26

[3.63]

[3.1744]

containsInclusive :: C.UTCTime -> Interval -> Bool
containsInclusive t (Interval s e) = t >= s && t <= e
replacement in lib/Quixotic/TimeLog.hs at line 46

[2.124]→[2.124:192](∅→∅)

compare StartWork StopWork = LT
compare StopWork StartWork = GT

[2.124]

[2.192]

compare StartWork StopWork = GT
compare StopWork StartWork = LT
edit in lib/Quixotic/TimeLog.hs at line 68

[3.1407]

[3.540]

instance Ord WorkEvent where
compare a b =
let cv x = (x ^. eventTime, x ^. eventType)
in compare (cv a) (cv b)
replacement in lib/Quixotic/TimeLog.hs at line 120

[2.492]→[3.378:434](∅→∅),[3.88]→[3.378:434](∅→∅)

type RawIndex = Map BtcAddr ([LogEntry], [LogInterval])

[2.492]

[3.982]

type RawIndex = Map BtcAddr [Either WorkEvent Interval]
replacement in lib/Quixotic/TimeLog.hs at line 160

[3.4420]→[2.653:778](∅→∅)

let sortedEntries :: Heap LogEntry
sortedEntries = F.foldr H.insert H.empty $ logEntries

rawIndex :: RawIndex

[3.4420]

[2.778]

let sortedEntries = F.foldr H.insert H.empty $ logEntries
replacement in lib/Quixotic/TimeLog.hs at line 163

[2.845]→[2.845:945](∅→∅)

accum k (_, l) m = case nonEmpty l of
Just l' -> MS.insert k (workInterval <$> l') m

[2.845]

[2.945]

accum k l m = case nonEmpty (rights l) of
Just l' -> MS.insert k l' m
replacement in lib/Quixotic/TimeLog.hs at line 170

[3.2117]→[3.4573:4654](∅→∅),[3.4654]→[2.1026:1069](∅→∅)

appendLogEntry idx entry =
let acc = reduceToIntervals $ pushEntry entry idx
in MS.insert (entry ^. btcAddr) acc idx

[3.2117]

[3.2252]

appendLogEntry idx (LogEntry k ev) =
let combine (WorkEvent StartWork t _) (WorkEvent StopWork t' _) | t' > t = Right $ Interval t t'
combine (e1 @ (WorkEvent StartWork _ _)) (e2 @ (WorkEvent StartWork _ _)) = Left $ max e1 e2
combine (e1 @ (WorkEvent StopWork _ _)) (e2 @ (WorkEvent StopWork _ _)) = Left $ min e1 e2
combine _ e2 = Left e2
replacement in lib/Quixotic/TimeLog.hs at line 176

[3.2253]→[2.1070:1212](∅→∅),[2.1212]→[3.2253:2318](∅→∅),[3.2253]→[3.2253:2318](∅→∅),[3.2318]→[3.4695:4779](∅→∅)

{-|
- Find the set of accumulated log intervals and log entries
- for a given BTC address, and concatenate the entry to the entry list.
-}
pushEntry :: LogEntry -> RawIndex -> ([LogEntry], [LogInterval])
pushEntry entry = first (entry :) . MS.findWithDefault ([], []) (entry ^. btcAddr)

[3.2253]

[3.869]

ivals = case MS.lookup k idx of
Just (Left ev' : xs) -> combine ev' ev : xs
Just xs -> Left ev : xs
Nothing -> Left ev : []
replacement in lib/Quixotic/TimeLog.hs at line 181

[3.870]→[3.692:772](∅→∅),[3.772]→[3.4024:4147](∅→∅),[3.4147]→[3.2859:2916](∅→∅),[3.4899]→[3.2859:2916](∅→∅),[3.2859]→[3.2859:2916](∅→∅),[3.2916]→[3.1086:1131](∅→∅),[3.2482]→[3.1086:1131](∅→∅)

reduceToIntervals :: ([LogEntry], [LogInterval]) -> ([LogEntry], [LogInterval])
reduceToIntervals ((LogEntry addr (WorkEvent StopWork end' _)) : (LogEntry _ (WorkEvent StartWork start' _)) : xs, acc) =
(xs, (LogInterval addr (interval start' end')) : acc)
reduceToIntervals misaligned =
misaligned

[3.870]

[3.22]

in MS.insert k ivals idx
replacement in test/Quixotic/TimeLogSpec.hs at line 33

[2.1990]→[3.3566:3589](∅→∅),[3.3566]→[3.3566:3589](∅→∅),[3.3589]→[2.1991:2045](∅→∅)

delta <- arbitrary
pure $ I.interval startTime (startTime .+^ delta)

[2.1990]

[2.2045]

delta <- arbitrary :: Gen (Positive T.NominalDiffTime)
pure $ I.interval startTime (startTime .+^ getPositive delta)
replacement in test/Quixotic/TimeLogSpec.hs at line 52

[2.2516]→[2.2516:2568](∅→∅)

, parseISO8601 "2014-02-12T00:12:00Z" ]

[2.2516]

[3.4253]

, parseISO8601 "2014-01-01T00:12:00Z" ]
replacement in test/Quixotic/TimeLogSpec.hs at line 56

[2.2674]→[2.2674:2726](∅→∅),[3.904]→[3.2686:2687](∅→∅),[2.2726]→[3.2686:2687](∅→∅),[3.3974]→[3.2686:2687](∅→∅),[3.4380]→[3.2686:2687](∅→∅),[3.2687]→[2.2727:2773](∅→∅),[2.2773]→[3.944:1004](∅→∅),[3.944]→[3.944:1004](∅→∅),[3.1004]→[2.2774:2973](∅→∅)

, parseISO8601 "2014-02-12T00:18:00Z" ]

testLogEntries :: NonEmpty LogEntry
testLogEntries = do
addr <- testAddrs
(start', end') <- L.zip starts ends
L.fromList [ LogEntry addr (WorkEvent StartWork start' Nothing)
, LogEntry addr (WorkEvent StopWork end' Nothing) ]

[2.2674]

[3.417]

, parseISO8601 "2014-01-01T00:18:00Z" ]
replacement in test/Quixotic/TimeLogSpec.hs at line 59

[2.3022]→[2.3022:3063](∅→∅)

testIntervals = L.reverse $ do

[2.3022]

[3.1197]

testIntervals = do
edit in test/Quixotic/TimeLogSpec.hs at line 63

[2.3173]

[2.3173]

testLogEntries :: NonEmpty LogEntry
testLogEntries = do
(LogInterval addr (Interval start' end')) <- testIntervals
L.fromList [ LogEntry addr (WorkEvent StartWork start' Nothing)
, LogEntry addr (WorkEvent StopWork end' Nothing) ]
edit in test/Quixotic/TimeLogSpec.hs at line 70

[2.3174]

[2.3174]

expected' = fromListWith (<>) . L.toList $ (intervalBtcAddr &&& pure . workInterval) <$> testIntervals
replacement in test/Quixotic/TimeLogSpec.hs at line 72

[2.3206]→[2.3206:3330](∅→∅)

expected = WorkIndex . fromListWith (<>) . L.toList $ (intervalBtcAddr &&& pure . workInterval) <$> testIntervals

[2.3206]

[3.2824]

expected = WorkIndex $ fmap (L.reverse . L.sort) expected'
replacement in test/Quixotic/TimeLogSpec.hs at line 77

[2.3444]→[2.3444:3460](∅→∅)

\widx ->

[2.3444]

[2.3460]

\(WorkIndex widx) ->
replacement in test/Quixotic/TimeLogSpec.hs at line 82

[2.3717]→[2.3717:3832](∅→∅)

logEntries = foldrWithKey acc [] (widx ^. _WorkIndex)
in workIndex logEntries `shouldBe` widx

[2.3717]

[3.3975]

logEntries = foldrWithKey acc [] widx
in workIndex logEntries `shouldBe` (WorkIndex $ fmap (L.reverse . L.sort) widx)