Cleanup of EventLog types.

[?]

May 5, 2015, 9:26 PM

KNSI575VAW6HRCZYXOEPQ4DTSML4EORML5MV4DJBRKE7TXCPS4EAC

Dependencies

[2] OV5AKJHA Remove unused LogInterval type.
[3] I2KHGVD4 Require project permissions for access to most data.
[4] 7XN3I3QJ Add 'loggedIntervals' endpoint.
[5] IZEVQF62 Work in progress replacing sqlite with postgres.
[6] 7KZP4RHZ Switch from Data.Time to Data.Thyme
[7] 5DRIWGLU Improving TimeLog specs
[8] GKGVYBZG Added JSON serialization to TimeLog
[9] 2OIPAQCB Merge branch 'master' of github.com:nuttycom/ananke
[10] RSEB2NFG Replacing Snap with Scotty.
[11] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
[12] OBFPJS2G Project successfully builds and tests under nix.
[13] EZQG2APB Update task list.
[14] TLQ72DSJ Lenses, sqlite-simple
[15] EQXRXRZD Changed to use tasty instead of test-framework
[16] N4NDAZYT Initial implementation of payouts.
[17] A2J7B4SC Initial impl of depreciation function.
[18] BROSTG5K Beginning of modularization of server.
[19] Z7KS5XHH Very WIP. Wow.
[20] FD7SV5I6 Fix handling of event_t columns.
[21] A6HKMINB Attempting to improve JSON handling.
[22] 2KZPOGRB Once you get Haskell to compile, the tests pass!
[23] TNR3TEHK Switch to Postgres + snaplet arch compiles.
[24] 4QX5E5AC Initial compilation of payouts function succeeds.
[25] SCXG6TJW Make log reduction safer in presence of overlapping events.
[26] 7DBNV3GV Initial, stack-based impl of time log event reduction.
[27] NMWWP4ZN Trying out Hspec
[28] SLL7262C Make depreciation functions more flexible.
[29] EMVTF2IW WIP moving back to snap.
[30] NVOCQVAS Initial failing tests.
[31] Y35QCWYW Minor improvement in WorkIndex type to eliminate duplicated information.
[32] NTPC7KJE Trivial changes, feature scratchpad.
[33] JUUMYIQE Add groupBy utility function for use in TimeLog.

Change contents

edit in lib/Quixotic/Database/PostgreSQL.hs at line 8

[3.713]

[3.713]

import Data.ByteString.Char8 as B
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 27

[3.1124]→[3.1124:1165](∅→∅)

eventTypeParser :: FieldParser EventType

[3.1124]

[3.4]

eventTypeParser :: FieldParser (C.UTCTime -> LogEvent)
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 31

[3.62]→[3.62:223](∅→∅)

"event_t" -> maybe (returnError UnexpectedNull f "") (nameEvent . decodeUtf8) v
_ -> returnError Incompatible f "column was not of type event_t"

[3.62]

[3.223]

"event_t" ->
let err = UnexpectedNull (B.unpack tn)
(tableOid f)
(maybe "" B.unpack (name f))
"UTCTime -> LogEvent"
"columns of type event_t should not contain null values"
in maybe (conversionError err) (nameEvent . decodeUtf8) v
_ ->
let err = Incompatible (B.unpack tn)
(tableOid f)
(maybe "" B.unpack (name f))
"UTCTime -> LogEvent"
"column was not of type event_t"
in conversionError err
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 69

[3.1607]→[3.1607:1646](∅→∅),[3.1646]→[3.137:229](∅→∅)

workEventParser :: RowParser WorkEvent
workEventParser = WorkEvent <$> fieldWith eventTypeParser <*> fieldWith utcParser <*> field

[3.1607]

[3.1715]

workEventParser :: RowParser LogEvent
workEventParser = fieldWith eventTypeParser <*> fieldWith utcParser
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 73

[3.1753]→[3.1753:1829](∅→∅)

logEntryParser = LogEntry <$> fieldWith btcAddrParser <*> workEventParser

[3.1753]

[3.1829]

logEntryParser = LogEntry <$> fieldWith btcAddrParser <*> workEventParser <*> field
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 149

[3.1426]→[3.1426:1489](∅→∅)

recordEvent' (ProjectId pid) (UserId uid) (LogEntry a e) = do

[3.1426]

[3.1489]

recordEvent' (ProjectId pid) (UserId uid) (LogEntry a e m) = do
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 156

[3.3665]→[3.3340:3378](∅→∅),[3.3340]→[3.3340:3378](∅→∅),[3.3378]→[3.230:263](∅→∅),[3.263]→[3.3666:3687](∅→∅),[3.3399]→[3.3666:3687](∅→∅)

, e ^. (eventType . to eventName)
, fromThyme $ e ^. eventTime
, e ^. eventMeta

[3.3665]

[3.3399]

, eventName e
, fromThyme $ eventTime e
, m
replacement in lib/Quixotic/TimeLog.hs at line 6

[3.924]→[3.3531:3550](∅→∅),[3.944]→[3.3551:3569](∅→∅)

, btcAddr, event
, EventType(..)

[3.924]

[3.3569]

, btcAddr, event, eventMeta
, LogEvent(..)
edit in lib/Quixotic/TimeLog.hs at line 9

[3.3594]→[3.75:93](∅→∅),[3.944]→[3.75:93](∅→∅),[3.93]→[3.3818:3854](∅→∅)

, WorkEvent(..)
, eventType, eventTime, eventMeta
replacement in lib/Quixotic/TimeLog.hs at line 40

[3.1225]→[3.444:512](∅→∅)

data EventType = StartWork | StopWork deriving (Show, Eq, Typeable)

[3.1225]

[3.5414]

data LogEvent = StartWork { eventTime :: C.UTCTime }
| StopWork { eventTime :: C.UTCTime }
deriving (Show, Eq)
makePrisms ''LogEvent
replacement in lib/Quixotic/TimeLog.hs at line 45

[3.5415]→[3.95:124](∅→∅),[3.124]→[3.239:307](∅→∅),[3.307]→[3.192:211](∅→∅),[3.192]→[3.192:211](∅→∅)

instance Ord EventType where
compare StartWork StopWork = GT
compare StopWork StartWork = LT
compare _ _ = EQ

[3.5415]

[3.211]

instance Ord LogEvent where
compare (StartWork t0) (StopWork t1) = if t0 == t1 then GT else compare t0 t1
compare (StopWork t0) (StartWork t1) = if t0 == t1 then LT else compare t0 t1
compare (StartWork t0) (StartWork t1) = compare t0 t1
compare (StopWork t0) (StopWork t1) = compare t0 t1
replacement in lib/Quixotic/TimeLog.hs at line 51

[3.212]→[3.3716:3806](∅→∅),[3.5415]→[3.3716:3806](∅→∅)

eventName :: EventType -> Text
eventName StartWork = "start"
eventName StopWork = "stop"

[3.212]

[3.3806]

eventName :: LogEvent -> Text
eventName (StartWork _) = "start"
eventName (StopWork _) = "stop"
replacement in lib/Quixotic/TimeLog.hs at line 55

[3.3807]→[3.3807:3855](∅→∅)

nameEvent :: MonadPlus m => Text -> m EventType

[3.3807]

[3.3855]

nameEvent :: MonadPlus m => Text -> m (C.UTCTime -> LogEvent)
edit in lib/Quixotic/TimeLog.hs at line 59

[3.320]→[3.1282:1283](∅→∅),[3.2736]→[3.1282:1283](∅→∅),[3.3954]→[3.1282:1283](∅→∅),[3.5515]→[3.1282:1283](∅→∅),[3.1282]→[3.1282:1283](∅→∅),[3.1283]→[3.3955:4011](∅→∅),[3.4011]→[3.863:891](∅→∅),[3.891]→[3.3879:3997](∅→∅),[3.4037]→[3.3879:3997](∅→∅),[3.3997]→[3.513:545](∅→∅),[3.545]→[3.4037:4084](∅→∅),[3.4023]→[3.4037:4084](∅→∅),[3.4037]→[3.4037:4084](∅→∅),[3.539]→[3.1406:1407](∅→∅),[3.2759]→[3.1406:1407](∅→∅),[3.1406]→[3.1406:1407](∅→∅),[3.1407]→[3.308:431](∅→∅)

data WorkEvent = WorkEvent
{ _eventType :: EventType
, _eventTime :: C.UTCTime
-- Permit the inclusion of arbitrary JSON data that may be refactored into
-- proper typed fields in the future.
, _eventMeta :: Maybe A.Value
} deriving (Show, Eq)
makeLenses ''WorkEvent

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 62

[3.4213]→[3.4213:4238](∅→∅)

, _event :: WorkEvent

[3.4213]

[3.613]

, _event :: LogEvent
, _eventMeta :: Maybe A.Value
replacement in lib/Quixotic/TimeLog.hs at line 69

[3.259]→[3.259:343](∅→∅)

let ordElems e = (e ^. (event.eventTime), e ^. (event.eventType), e ^. btcAddr)

[3.259]

[3.343]

let ordElems e = (e ^. event, e ^. btcAddr)
edit in lib/Quixotic/TimeLog.hs at line 103

[3.492]→[3.433:489](∅→∅),[3.489]→[3.982:1011](∅→∅),[3.434]→[3.982:1011](∅→∅),[3.77]→[3.350:351](∅→∅),[3.88]→[3.350:351](∅→∅),[3.159]→[3.350:351](∅→∅),[3.434]→[3.350:351](∅→∅),[3.1011]→[3.350:351](∅→∅),[3.350]→[3.350:351](∅→∅)

type RawIndex = Map BtcAddr [Either WorkEvent Interval]
type NDT = C.NominalDiffTime
edit in lib/Quixotic/TimeLog.hs at line 110

[3.6766]

[3.89]

type NDT = C.NominalDiffTime
edit in lib/Quixotic/TimeLog.hs at line 151

[3.449]

[3.2066]

{-|
- The values of the raw index map are either complete intervals (which may be
- extended if a new start is encountered at the same instant as the end of the
- interval) or start events awaiting completion.
-}
type RawIndex = Map BtcAddr [Either LogEvent Interval]
replacement in lib/Quixotic/TimeLog.hs at line 159

[3.2117]→[3.637:973](∅→∅)

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

[3.2117]

[3.973]

appendLogEntry idx (LogEntry k ev _) =
let combine (StartWork t) (StopWork t') | t' > t = Right $ Interval t t'
combine (e1 @ (StartWork _)) (e2 @ (StartWork _)) = Left $ min e1 e2 -- ignore redundant starts
combine (e1 @ (StopWork _)) (e2 @ (StopWork _)) = Left $ min e1 e2 -- ignore redundant ends
edit in lib/Quixotic/TimeLog.hs at line 164

[3.1002]

[3.2252]

-- if the interval includes the timestamp of a start event, then allow the extension of the interval
extension :: Interval -> LogEvent -> Maybe LogEvent
extension ival (StartWork t) | containsInclusive t ival = Just $ StartWork (ival ^. start)
extension _ _ = Nothing
edit in lib/Quixotic/TimeLog.hs at line 171

[3.1041]

[3.1041]

-- if it is possible to extend an interval at the top of the stack
-- because the end of that interval is the same
Just (Right ival : xs) -> case extension ival ev of
Just e' -> Left e' : xs
Nothing -> Left ev : Right ival : xs
-- if the top element of the stack is not an interval
replacement in lib/Quixotic/TimeLog.hs at line 178

[3.1093]→[3.1093:1157](∅→∅)

Just xs -> Left ev : xs
Nothing -> Left ev : []

[3.1093]

[3.869]

_ -> Left ev : []
edit in lib/Quixotic/TimeLog.hs at line 186

[3.2114]→[3.2114:2117](∅→∅)

-
replacement in server/Quixotic/Snaplet/WorkLog.hs at line 21

[3.5831]→[3.7589:7644](∅→∅),[3.7644]→[3.3341:3369](∅→∅),[3.5881]→[3.3341:3369](∅→∅)

logWorkHandler :: EventType -> Handler App App EventId
logWorkHandler evType = do

[3.5831]

[3.5933]

logWorkHandler :: (C.UTCTime -> LogEvent) -> Handler App App EventId
logWorkHandler evCtr = do
replacement in server/Quixotic/Snaplet/WorkLog.hs at line 29

[3.3064]→[3.550:618](∅→∅),[3.6042]→[3.550:618](∅→∅),[3.618]→[3.4128:4208](∅→∅),[3.4460]→[3.4128:4208](∅→∅),[3.6087]→[3.4128:4208](∅→∅)

let workEvent = WorkEvent evType timestamp $ A.decode requestBody
storeEv addr = runReaderT . recordEvent pid uid $ LogEntry addr workEvent

[3.3064]

[3.6163]

let logEntry addr = LogEntry addr (evCtr timestamp) (A.decode requestBody)
storeEv addr = runReaderT . recordEvent pid uid $ logEntry addr
replacement in test/Quixotic/TimeLogSpec.hs at line 10

[3.1747]→[3.1747:1807](∅→∅)

import Data.List.NonEmpty as L
import Data.Map.Strict as M

[3.1747]

[3.1807]

import qualified Data.List.NonEmpty as L
import qualified Data.Map.Strict as M
edit in test/Quixotic/TimeLogSpec.hs at line 22

[3.3280]→[3.3280:3401](∅→∅)

instance Arbitrary EventType where
arbitrary = elements [StartWork, StopWork]

newtype EventLog = EventLog [LogEntry]
edit in test/Quixotic/TimeLogSpec.hs at line 30

[3.1315]

[3.2045]

newtype Intervals = Intervals (L.NonEmpty Interval)

buildIntervals :: T.UTCTime -> [NominalDiffTime] -> [Interval]
buildIntervals t (d : s : dx) =
let ival = I.interval t (t .+^ d)
in ival : buildIntervals (ival ^. end .+^ (abs s)) dx
buildIntervals _ _ = []

instance Arbitrary Intervals where
arbitrary = do
startTime <- arbitrary
let deltas = filter (> 0) <$> listOf arbitrary
intervals <- suchThat (buildIntervals startTime <$> deltas) (not.null)
pure . Intervals $ L.fromList intervals
replacement in test/Quixotic/TimeLogSpec.hs at line 48

[3.2096]→[3.2096:2170](∅→∅)

let record = (,) <$> arbitrary <*> (L.fromList <$> listOf1 arbitrary)

[3.2096]

[3.2170]

let record = do addr <- arbitrary
Intervals ivals <- arbitrary
pure (addr, ivals)
replacement in test/Quixotic/TimeLogSpec.hs at line 67

[2.125]→[3.2624:2674](∅→∅),[3.2624]→[3.2624:2674](∅→∅)

[ parseISO8601 "2014-01-01T00:12:00Z"

[2.125]

[3.1369]

[ parseISO8601 "2014-01-01T00:11:59Z"
replacement in test/Quixotic/TimeLogSpec.hs at line 79

[2.385]→[2.385:485](∅→∅)

LogEntry addr <$> [WorkEvent StartWork start' Nothing, WorkEvent StopWork end' Nothing]

[2.385]

[3.3173]

LogEntry addr <$> [StartWork start', StopWork end'] <*> [Nothing]
replacement in test/Quixotic/TimeLogSpec.hs at line 81

[3.3174]→[2.486:561](∅→∅)

expected' = fromListWith (<>) $ fmap (second pure) testIntervals

[3.3174]

[2.561]

expected' = M.fromListWith (<>) $ fmap (second pure) testIntervals
replacement in test/Quixotic/TimeLogSpec.hs at line 88

[3.1964]→[3.3460:3656](∅→∅),[3.3460]→[3.3460:3656](∅→∅)

let ivalEntries addr ival = [ LogEntry addr (WorkEvent StartWork (ival ^. start) Nothing)
, LogEntry addr (WorkEvent StopWork (ival ^. end) Nothing) ]

[3.1964]

[3.4635]

let ivalEntries addr ival = LogEntry addr <$> [StartWork (ival ^. start), StopWork (ival ^. end)]
<*> [Nothing]
replacement in test/Quixotic/TimeLogSpec.hs at line 92

[3.3717]→[3.1965:2015](∅→∅)

logEntries = foldrWithKey acc [] widx

[3.3717]

[3.2015]

logEntries = M.foldrWithKey acc [] widx
edit in test/Quixotic/TimeLogSpec.hs at line 95

[3.3976]→[3.3976:4116](∅→∅),[3.1679]→[3.974:975](∅→∅),[3.4083]→[3.974:975](∅→∅),[3.4116]→[3.974:975](∅→∅),[3.4710]→[3.974:975](∅→∅)

describe "EventType serialization" $ do
it "serialization is invertible" $ property $
\e -> (nameEvent . eventName) e == Just e