Minor improvement in WorkIndex type to eliminate duplicated information.

Dependencies

• [2] 2KZPOGRB Once you get Haskell to compile, the tests pass!
• [3] 4QX5E5AC Initial compilation of payouts function succeeds.
• [4] 7DBNV3GV Initial, stack-based impl of time log event reduction.
• [5] JUUMYIQE Add groupBy utility function for use in TimeLog.
• [6] EQXRXRZD Changed to use tasty instead of test-framework
• [7] N4NDAZYT Initial implementation of payouts.
• [8] NVOCQVAS Initial failing tests.
• [9] ADMKQQGC Initial empty Snap project.

Change contents

• replacement in ananke.cabal at line 32
  [4.442]→[4.442:522](∅→∅)
  − containers == 0.5.*,

  − postgresql-simple >= 0.3.10
  [4.442]

  [4.741]
  + containers == 0.5.*
• edit in ananke.cabal at line 44
  [4.788]

  [4.788]
  + bifunctors,
• replacement in src/Ananke/TimeLog.hs at line 6
  [4.944]→[4.944:961](∅→∅)
  − , LogEvent(..)
  [4.944]

  [4.961]
  + , WorkEvent(..)

  + , WorkIndex
• replacement in src/Ananke/TimeLog.hs at line 20
  [4.1081]→[4.1081:1167](∅→∅)
  − import Database.PostgreSQL.Simple.FromRow

  − import Database.PostgreSQL.Simple.FromField
  [4.1081]

  [4.1167]
  + -- import Database.PostgreSQL.Simple.FromRow

  + -- import Database.PostgreSQL.Simple.FromField
• replacement in src/Ananke/TimeLog.hs at line 25
  [4.1225]→[4.1225:1282](∅→∅)
  − data LogEvent = StartWork | StopWork deriving (Show, Eq)
  [4.1225]

  [4.1282]
  + data WorkEvent = StartWork { logTime :: UTCTime }

  + | StopWork { logTime :: UTCTime } deriving (Show, Eq)
• replacement in src/Ananke/TimeLog.hs at line 31
  [4.1407]→[4.1407:1724](∅→∅)
  − instance FromField LogEvent where

  − fromField f m = let fromText "start_work" = return StartWork

  − fromText "stop_work" = return StopWork

  − fromText a = conversionError $ LogEventParseError $ "unrecognized log event type " ++ a

  − in fromField f m >>= fromText
  [4.1407]

  [4.1724]
  + -- instance FromField WorkEvent where

  + -- fromField f m = let fromText "start_work" = return StartWork

  + -- fromText "stop_work" = return StopWork

  + -- fromText a = conversionError $ LogEventParseError $ "unrecognized log event type " ++ a

  + -- in fromField f m >>= fromText
• replacement in src/Ananke/TimeLog.hs at line 38
  [4.1771]→[4.1771:1863](∅→∅)
  − , logTime :: UTCTime

  − , event :: LogEvent
  [4.1771]

  [4.1863]
  + , event :: WorkEvent
• replacement in src/Ananke/TimeLog.hs at line 41
  [4.2201]→[4.2201:2285](∅→∅)
  − instance FromRow LogEntry where

  − fromRow = LogEntry <$> field <*> field <*> field
  [4.2124]

  [4.2285]
  + -- instance FromRow LogEntry where

  + -- fromRow = LogEntry <$> field <*> field <*> field
• replacement in src/Ananke/TimeLog.hs at line 48
  [4.2287]→[4.293:350](∅→∅)
  − type WorkIndex = Map BtcAddr ([LogEntry], [LogInterval])
  [4.2287]

  [4.123]
  + type WorkIndex = Map BtcAddr ([WorkEvent], [Interval])
• replacement in src/Ananke/TimeLog.hs at line 65
  [3.588]→[3.588:1011](∅→∅)
  − payouts dep ptime widx = let addIntervalDiff :: (Functor f, Foldable f) => NDT -> f LogInterval -> (NDT, NDT)

  − addIntervalDiff total ivals = (\dt -> (dt + total, dt)) $ sumLogIntervals dep ptime ivals

  − (totalTime, keyTimes) = M.mapAccum addIntervalDiff (fromInteger 0) $ M.map snd widx

  − in M.map (\kt -> toRational $ kt / totalTime) keyTimes
  [3.588]

  [3.1011]
  + payouts dep ptime widx =

  + let addIntervalDiff :: (Functor f, Foldable f) => NDT -> f Interval -> (NDT, NDT)

  + addIntervalDiff total ivals = (\dt -> (dt + total, dt)) $ workCredit dep ptime ivals

  + (totalTime, keyTimes) = M.mapAccum addIntervalDiff (fromInteger 0) $ M.map snd widx

  + in M.map (\kt -> toRational $ kt / totalTime) keyTimes
• replacement in src/Ananke/TimeLog.hs at line 72
  [3.1016]→[3.1016:1019](∅→∅)
  −
  [3.1016]

  [3.1019]
  + Given a depreciation function, the "current" time, and a foldable functor of log intervals,

  + produce the total, depreciated length of work to be credited to an address.
• replacement in src/Ananke/TimeLog.hs at line 75
  [3.1022]→[3.1022:1223](∅→∅)
  − sumLogIntervals :: (Functor f, Foldable f) => Depreciation -> UTCTime -> f LogInterval -> NDT

  − sumLogIntervals dep ptime ivals = F.foldl' (+) (fromInteger 0) $ fmap (depreciateInterval dep ptime) ivals
  [3.1022]

  [4.599]
  + workCredit :: (Functor f, Foldable f) => Depreciation -> UTCTime -> f Interval -> NDT

  + workCredit dep ptime ivals = F.foldl' (+) (fromInteger 0) $ fmap (depreciateInterval dep ptime) ivals
• replacement in src/Ananke/TimeLog.hs at line 78
  [4.600]→[3.1224:1581](∅→∅)
  − depreciateInterval :: Depreciation -> UTCTime -> LogInterval -> NDT

  − depreciateInterval dep ptime ival = let depreciation :: Rational

  − depreciation = depf dep $ diffUTCTime ptime (end . workInterval $ ival)

  − in fromRational $ depreciation * (toRational . ilen . workInterval $ ival)
  [4.600]

  [3.1581]
  + {-|

  + Compute the depreciated difftime for a single Interval value.

  + -}

  + depreciateInterval :: Depreciation -> UTCTime -> Interval -> NDT

  + depreciateInterval dep ptime ival =

  + let depreciation :: Rational

  + depreciation = depf dep $ diffUTCTime ptime (end $ ival)

  + in fromRational $ depreciation * (toRational . ilen $ ival)
• replacement in src/Ananke/TimeLog.hs at line 88
  [4.403]→[4.403:448](∅→∅)
  − intervals = F.foldl' appendLogEntry M.empty
  [4.403]

  [4.448]
  + intervals logEntries = M.map (bimap (fmap event) (fmap workInterval)) $ F.foldl' appendLogEntry M.empty logEntries
• replacement in src/Ananke/TimeLog.hs at line 90
  [4.449]→[4.449:502](∅→∅),[4.502]→[4.601:691](∅→∅),[4.691]→[4.581:654](∅→∅),[4.581]→[4.581:654](∅→∅)
  − appendLogEntry :: WorkIndex -> LogEntry -> WorkIndex

  − appendLogEntry workIndex entry = let acc = reduceToIntervals $ pushEntry entry workIndex

  − in insert (btcAddr entry) acc workIndex
  [4.449]

  [4.25]
  + type RawIndex = Map BtcAddr ([LogEntry], [LogInterval])
• replacement in src/Ananke/TimeLog.hs at line 92
  [4.26]→[4.655:721](∅→∅)
  − pushEntry :: LogEntry -> WorkIndex -> ([LogEntry], [LogInterval])
  [4.26]

  [2.120]
  + appendLogEntry :: RawIndex -> LogEntry -> RawIndex

  + appendLogEntry workIndex entry =

  + let acc = reduceToIntervals $ pushEntry entry workIndex

  + in insert (btcAddr entry) acc workIndex

  +

  + pushEntry :: LogEntry -> RawIndex -> ([LogEntry], [LogInterval])
• replacement in src/Ananke/TimeLog.hs at line 101
  [4.772]→[4.772:928](∅→∅)
  − reduceToIntervals ((LogEntry addr end StopWork) : (LogEntry _ start StartWork) : xs, intervals) = (xs, (LogInterval addr (interval start end)) : intervals)
  [4.772]

  [4.928]
  + reduceToIntervals ((LogEntry addr (StopWork end)) : (LogEntry _ (StartWork start)) : xs, intervals) =

  + (xs, (LogInterval addr (interval start end)) : intervals)
• replacement in src/Ananke.hs at line 7
  [4.2548]→[4.2548:2592](∅→∅)
  − import Database.PostgreSQL.Simple.FromField
  [4.2548]

  [4.2592]
  + --import Database.PostgreSQL.Simple.FromField
• replacement in src/Ananke.hs at line 14
  [4.2764]→[4.2764:2845](∅→∅)
  − instance FromField BtcAddr where

  − fromField f m = fmap BtcAddr $ fromField f m
  [4.2764]

  [4.2845]
  + --instance FromField BtcAddr where

  + -- fromField f m = fmap BtcAddr $ fromField f m
• edit in test/Test.hs at line 1
  [4.3665]

  [4.1866]
  + {-# LANGUAGE ScopedTypeVariables #-}

  +
• edit in test/Test.hs at line 6
  [4.1943]

  [4.3744]
  + import Data.Bifunctor as B
• edit in test/Test.hs at line 37
  [4.4380]

  [4.4380]
  +

  + testLogEntries :: [LogEntry]
• replacement in test/Test.hs at line 42
  [4.4460]→[4.4460:4526](∅→∅)
  − [ LogEntry addr start StartWork, LogEntry addr end StopWork ]
  [4.4460]

  [2.417]
  + [ LogEntry addr (StartWork start), LogEntry addr (StopWork end) ]
• edit in test/Test.hs at line 44
  [2.418]

  [2.418]
  + testIntervals :: [LogInterval]
• edit in test/Test.hs at line 49
  [2.493]

  [2.493]
  +

  + expected0 :: Map BtcAddr ([LogEntry], [LogInterval])

  + expected0 = M.map (const [] &&& id) . fromListWith (++) . fmap (intervalBtcAddr &&& return) $ testIntervals
• replacement in test/Test.hs at line 53
  [2.494]→[2.494:601](∅→∅)
  − expected = M.map (\i -> ([], i)) . fromListWith (++) . fmap (intervalBtcAddr &&& return) $ testIntervals
  [2.494]

  [4.4635]
  + expected :: WorkIndex

  + expected = M.map (bimap (fmap event) (fmap workInterval)) expected0