Fix project selection, end log end on project switch.

[?]

Aug 19, 2020, 4:00 PM

ZIG57EE6RB22JGB3CT33EN2HVYCHCXBT5GROBTBMBLEMDTGQOOBQC

Dependencies

[2] QU5FW67R Add project selection to time tracker.
[3] 4IQVQL4T Added client for payouts endpoint.
[4] EW2XN7KU Update docker build, clean up migration for payments tables.
[5] JXG3FCXY Upgrade ps + halogen versions.
[6] 7VGYLTMU Clean up schema version handling.
[7] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
[8] GMYPBCWE Make docker-compose work.
[9] W35DDBFY Factor common JSON conversions up into client lib module.
[10] ASF3UPJL Add auction creation and bid handlers
[11] BROSTG5K Beginning of modularization of server.
[12] SEWTRB6S Implement payment request creation functions.
[13] AL37SVTC Implement payments service endpoints.
[14] NJNMO72S Add zcash.com submodule and update client to modern halogen.
[15] MGOF7IUF Update TASKS list to reflect completed projects.
[16] Z3MK2PJ5 Add GET handler for retrieving auction data.
[17] O722AOKE Add route to allow crediting of events to users/projects.
[18] KNSI575V Cleanup of EventLog types.
[19] WRPIYG3E Use project listing functionality to check for whether we have a cookie.
[20] HMDM3B55 Implement core of payments/billing infrastructure.
[21] BFZN4SUA Make timeline component work.
[22] GCVQD44V Create amends endpoint, switch to UUID primary keys
[23] O227CEAV Adds storage of original event JSON for some DBOp constructors.
[24] 73NDXDEZ Begin implementation of billing event persistence.
[25] XTBSG4C7 Adding serveJSON combinator to eliminate some boilerplate from handlers.
[26] 2XQD6KKK Add invitation logic and clean up DBProg error handling.
[27] A6HKMINB Attempting to improve JSON handling.
[28] NEDDHXUK Reformat via stylish-haskell
[29] UILI6PIL The route-based logStart/logStop is nicer.
[30] RPAJLHMT Change to use UUIDs instead of ints for primary keys.
[31] HO2PFRAB Client login now handles response correctly.
[32] EFSXYZPO Autoformat everything with brittany.
[33] IPG33FAW Add billing daemon
[34] B6HWAPDP Modularize & update to recent haskoin.
[35] Z7KS5XHH Very WIP. Wow.
[36] QMRKFEPG Refactor QDB to use a free monad algebra instead.
[*] IZEVQF62 Work in progress replacing sqlite with postgres.
[*] 4U7F3CPI THE GREAT RENAMING OF THINGS!
[*] ADMKQQGC Initial empty Snap project.

Change contents

edit in client/src/Aftok/Project.purs at line 14

[3.887]→[3.887:916](∅→∅)

import Data.JSDate as JSDate
edit in client/src/Aftok/Project.purs at line 15

[3.954]

[3.996]

import Data.JSDate as JSDate
edit in client/src/Aftok/Project.purs at line 17

[3.1026]

[2.108]

import Data.Newtype (class Newtype)
edit in client/src/Aftok/Project.purs at line 32

[2.263]

[2.263]

import Halogen.HTML.Core (ClassName(..))
replacement in client/src/Aftok/Project.purs at line 36

[2.332]→[2.332:368](∅→∅)

import Effect.Class.Console (error)

[2.332]

[2.368]

import Effect.Class.Console (log, error)
edit in client/src/Aftok/Project.purs at line 39

[2.404]

[2.404]

derive instance projectIdEq :: Eq ProjectId
derive instance newtypeProjectId :: Newtype ProjectId _
edit in client/src/Aftok/Project.purs at line 51

[3.1635]

[3.1635]

derive instance newtypeProject :: Newtype (Project' a) _
replacement in client/src/Aftok/Project.purs at line 90

[2.1320]→[2.1320:1518](∅→∅)

in HH.select
[E.onSelectedIndexChange (Just <<< Select)]
([HH.option [P.selected true, P.disabled true] [HH.text "Select a project"]] <> map renderOption st.projects)

[2.1320]

[2.1518]

in HH.div
[P.classes (ClassName <$> ["form-group"])]
[HH.label
[ P.classes (ClassName <$> ["sr-only"])
, P.for "projectSelect"
]
[ HH.text "Project" ]
,HH.select
[P.classes (ClassName <$> ["form-control"])
,P.id_ "projectSelect"
,E.onSelectedIndexChange (Just <<< Select)
]
([HH.option [P.selected true, P.disabled true] [HH.text "Select a project"]] <> map renderOption st.projects)
]
replacement in client/src/Aftok/Project.purs at line 116

[2.1902]→[2.1902:1947](∅→∅)

traverse_ H.raise (index projects i)

[2.1902]

[3.1869]

log $ "Selected project index " <> show i
traverse_ H.raise (index projects (i - 1))
replacement in client/src/Aftok/Timeline.purs at line 13

[2.2494]→[2.2494:2539](∅→∅)

import Data.Maybe (Maybe(..), maybe, isJust)

[2.2494]

[2.2539]

import Data.Foldable (any)
import Data.Maybe (Maybe(..), maybe, isJust, isNothing)
import Data.Newtype (unwrap)
replacement in client/src/Aftok/Timeline.purs at line 58

[3.3221]→[3.3221:3238](∅→∅)

type Interval =

[3.3221]

[3.3238]

type Interval =
replacement in client/src/Aftok/Timeline.purs at line 63

[3.3283]→[3.3283:3306](∅→∅)

type TimelineLimits =

[3.3283]

[3.301928]

type TimelineLimits =
replacement in client/src/Aftok/Timeline.purs at line 69

[3.3422]→[3.3422:3444](∅→∅)

type TimelineState =

[3.3422]

[3.301976]

type TimelineState =
replacement in client/src/Aftok/Timeline.purs at line 88

[3.3688]→[2.3159:3173](∅→∅)

type Slots =

[3.3688]

[2.3173]

type Slots =
replacement in client/src/Aftok/Timeline.purs at line 99

[3.259]→[2.3397:3408](∅→∅)

component

[3.259]

[2.3408]

component
replacement in client/src/Aftok/Timeline.purs at line 101

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

. Capability Aff

[2.3439]

[2.3460]

. Capability Aff
replacement in client/src/Aftok/Timeline.purs at line 104

[2.3536]→[2.3536:3574](∅→∅)

component caps pcaps = H.mkComponent

[2.3536]

[3.302289]

component caps pcaps = H.mkComponent
replacement in client/src/Aftok/Timeline.purs at line 106

[3.302306]→[3.4370:4382](∅→∅),[3.4370]→[3.4370:4382](∅→∅),[3.4382]→[3.302307:302343](∅→∅)

, render
, eval: H.mkEval $ H.defaultEval

[3.302306]

[3.302343]

, render
, eval: H.mkEval $ H.defaultEval
replacement in client/src/Aftok/Timeline.purs at line 109

[3.302371]→[3.302371:302409](∅→∅)

, initialize = Just Initialize

[3.302371]

[3.302409]

, initialize = Just Initialize
replacement in client/src/Aftok/Timeline.purs at line 113

[3.302461]→[3.302461:302483](∅→∅)

initialState _ =

[3.302461]

[2.3575]

initialState _ =
replacement in client/src/Aftok/Timeline.purs at line 121

[3.502]→[3.302724:302741](∅→∅),[2.3797]→[3.302724:302741](∅→∅),[3.302724]→[3.302724:302741](∅→∅),[3.302741]→[2.3798:3820](∅→∅)

render st =
let lineForm =

[2.3797]

[2.3820]

render st =
HH.section
[P.classes (ClassName <$> ["section-border", "border-primary"])]
[HH.div
[P.classes (ClassName <$> ["container", "pt-6"])]
[HH.h1
[P.classes (ClassName <$> ["mb-0", "font-weight-bold", "text-center"])]
[HH.text "Time Tracker"]
,HH.p
[P.classes (ClassName <$> ["col-md-5", "text-muted", "text-center", "mx-auto"])]
[HH.text "Today's project timeline"]
,HH.div_
[HH.slot _projectList unit (Project.projectListComponent pcaps) unit (Just <<< ProjectSelected)]
]
,HH.div
[P.classes (ClassName <$> if isNothing st.selectedProject then ["collapse"] else [])]
edit in client/src/Aftok/Timeline.purs at line 142

[2.4075]

[2.4075]

,P.disabled (isJust st.active)
edit in client/src/Aftok/Timeline.purs at line 148

[2.4281]

[2.4281]

,P.disabled (isNothing st.active)
replacement in client/src/Aftok/Timeline.purs at line 153

[3.303581]→[2.4338:5047](∅→∅)

in HH.section
[P.classes (ClassName <$> ["section-border", "border-primary"])]
([HH.div
[P.classes (ClassName <$> ["container-fluid", "pt-6"])]
[HH.h1
[P.classes (ClassName <$> ["mb-0", "font-weight-bold", "text-center"])]
[HH.text "Time Tracker"]
,HH.p
[P.classes (ClassName <$> ["col-md-5", "text-muted", "text-center", "mx-auto"])]
[HH.text "Today's project timeline"]
,HH.div_
[HH.slot _projectList unit (Project.projectListComponent pcaps) unit (Just <<< ProjectSelected)]
]
] <> (if isJust st.selectedProject then lineForm else []))

[3.303581]

[3.4812]

]
replacement in client/src/Aftok/Timeline.purs at line 162

[3.303950]→[3.303950:303972](∅→∅)

limits =

[3.303950]

[3.303972]

limits =
replacement in client/src/Aftok/Timeline.purs at line 177

[3.5215]→[2.5185:5213](∅→∅)

ProjectSelected p ->

[3.5215]

[2.5213]

ProjectSelected p -> do
active <- isJust <$> H.gets (_.active)
currentProject <- H.gets (_.selectedProject)
log $ "Active: " <> show active <> "; " <> show ((_.projectName) <<< unwrap <$> currentProject)
log $ "Selected: " <> show ((_.projectName) <<< unwrap $ p)
when (active && any (\p' -> (unwrap p').projectId /= (unwrap p).projectId) currentProject)
(traverse_ logEnd currentProject)
edit in client/src/Aftok/Timeline.purs at line 187

[3.304266]→[2.5266:5497](∅→∅)

let withProject (Project' p) = do
logged <- lift $ caps.logStart p.projectId
case logged of
Left _ -> log "Failed to start timer."
Right t -> H.modify_ (start t)
replacement in client/src/Aftok/Timeline.purs at line 188

[2.5543]→[2.5543:5641](∅→∅)

log $ "Project selected? " <> show (isJust project)
traverse_ withProject project

[2.5543]

[3.304322]

traverse_ logStart project
replacement in client/src/Aftok/Timeline.purs at line 191

[3.304343]→[2.5642:5953](∅→∅)

let withProject (Project' p) = do
logged <- lift $ caps.logEnd p.projectId
case logged of
Left _ -> log "Failed to stop timer."
Right t -> H.modify_ (stop t)
project <- H.gets (_.selectedProject)
traverse_ withProject project

[3.304343]

[3.304398]

currentProject <- H.gets (_.selectedProject)
traverse_ logEnd currentProject
replacement in client/src/Aftok/Timeline.purs at line 198

[3.304478]→[3.304478:304488](∅→∅)

lineHtml

[3.304478]

[3.304488]

logStart :: Project -> H.HalogenM TimelineState TimelineAction Slots output Aff Unit
logStart (Project' p) = do
logged <- lift $ caps.logStart p.projectId
case logged of
Left _ -> log "Failed to start timer."
Right t -> H.modify_ (start t)

logEnd :: Project -> H.HalogenM TimelineState TimelineAction Slots output Aff Unit
logEnd (Project' p) = do
logged <- lift $ caps.logEnd p.projectId
case logged of
Left _ -> log "Failed to stop timer."
Right t -> H.modify_ (stop t)

lineHtml
replacement in client/src/Aftok/Timeline.purs at line 227

[3.5481]→[3.304867:304881](∅→∅)

intervalHtml

[3.5481]

[3.304881]

intervalHtml
replacement in client/src/Aftok/Timeline.purs at line 229

[3.304908]→[2.5954:5975](∅→∅),[2.5975]→[3.304950:304965](∅→∅),[3.304950]→[3.304950:304965](∅→∅)

. TimelineLimits
-> Interval

[3.304908]

[3.304965]

. TimelineLimits
-> Interval
replacement in client/src/Aftok/Timeline.purs at line 232

[3.305001]→[2.5976:6001](∅→∅)

intervalHtml limits i =

[3.305001]

[3.1082]

intervalHtml limits i =
replacement in client/src/Aftok/Timeline.purs at line 234

[3.1128]→[3.1128:1204](∅→∅)

ileft = ilen limits.start i.start
iwidth = ilen i.start i.end

[3.1128]

[3.3544]

ileft = ilen limits.start i.start
iwidth = ilen i.start i.end
replacement in client/src/Aftok/Timeline.purs at line 239

[3.305233]→[3.305233:305254](∅→∅)

[ CSS.style do

[3.305233]

[3.305254]

[ CSS.style do
replacement in client/src/Aftok/Timeline.purs at line 260

[3.6275]→[3.6275:6288](∅→∅)

start t s =

[3.6275]

[3.305764]

start t s =
replacement in client/src/Aftok/Timeline.purs at line 265

[3.6438]→[3.6438:6450](∅→∅)

stop t s =

[3.6438]

[3.305825]

stop t s =
replacement in client/src/Aftok/Timeline.purs at line 271

[3.6639]→[3.6639:6654](∅→∅)

refresh t s =

[3.6639]

[3.1347]

refresh t s =
replacement in client/src/Aftok/Timeline.purs at line 273

[3.1387]→[3.1387:1432](∅→∅)

, active = map (_ { end = t }) s.active

[3.1387]

[3.306012]

, active = map (_ { end = t }) s.active
replacement in client/src/Aftok/Timeline.purs at line 277

[3.6800]→[3.306019:306039](∅→∅)

ilen _start _end =

[3.6800]

[3.6813]

ilen _start _end =
replacement in client/src/Aftok/Timeline.purs at line 281

[3.6890]→[2.6002:6092](∅→∅)

logStart :: ProjectId -> Aff (Either TimelineError Instant)
logStart (ProjectId pid) = do

[3.6890]

[2.6092]

apiLogStart :: ProjectId -> Aff (Either TimelineError Instant)
apiLogStart (ProjectId pid) = do
replacement in client/src/Aftok/Timeline.purs at line 292

[2.6623]→[2.6623:6709](∅→∅)

logEnd :: ProjectId -> Aff (Either TimelineError Instant)
logEnd (ProjectId pid) = do

[2.6623]

[2.6709]

apiLogEnd :: ProjectId -> Aff (Either TimelineError Instant)
apiLogEnd (ProjectId pid) = do
replacement in client/src/Aftok/Timeline.purs at line 304

[2.7270]→[2.7270:7307](∅→∅)

apiCapability = { logStart, logEnd }

[2.7270]

[2.7307]

apiCapability = { logStart: apiLogStart, logEnd: apiLogEnd }
replacement in client/src/Aftok/Timeline.purs at line 307

[3.1466]→[3.1466:1484](∅→∅)

mockCapability =

[3.1466]

[2.7309]

mockCapability =
replacement in lib/Aftok/Database/PostgreSQL.hs at line 589

[3.23482]→[3.23482:23571](∅→∅)

[sql| SELECT p.id, p.project_name, p.inception_date, p.initiator_id, p.depreciation_fn

[3.23482]

[3.15643]

[sql| SELECT DISTINCT ON (p.inception_date, p.id) p.id, p.project_name, p.inception_date, p.initiator_id, p.depreciation_fn
replacement in lib/Aftok/Database/PostgreSQL.hs at line 592

[3.15762]→[3.20139:20174](∅→∅),[3.20139]→[3.20139:20174](∅→∅)

OR p.initiator_id = ? |]

[3.15762]

[3.23572]

OR p.initiator_id = ?
ORDER BY p.inception_date, p.id |]
edit in lib/Aftok/Json.hs at line 16

[3.31084]

[3.31084]

import qualified Control.Lens as L
edit in lib/Aftok/Json.hs at line 44

[3.20856]

[3.32274]

import Aftok.Database ( KeyedLogEntry )
replacement in lib/Aftok/Json.hs at line 131

[3.2437]→[3.33234:33283](∅→∅)

idValue :: forall a . Lens' a UUID -> a -> Value

[3.2437]

[3.21821]

idValue :: forall a . Getter a UUID -> a -> Value
replacement in lib/Aftok/Json.hs at line 134

[3.1700]→[3.33284:33340](∅→∅)

idJSON :: forall a . Text -> Lens' a UUID -> a -> Value

[3.1700]

[3.33340]

idJSON :: forall a . Text -> Getter a UUID -> a -> Value
replacement in lib/Aftok/Json.hs at line 137

[3.486]→[3.26352:26421](∅→∅),[3.26421]→[3.33384:33470](∅→∅)

qdbJSON :: Text -> (Lens' a UUID) -> (b -> Value) -> (a, b) -> Value
qdbJSON name l f (xid, x) =
v1 $ obj [(name <> "Id") .= idValue l xid, name .= f x]

[3.486]

[3.249]

qdbJSON :: Text -> Getter a UUID -> Getter a Value -> a -> Value
qdbJSON name _id _value x =
v1 $ obj
[(name <> "Id") .= idValue _id x
, name .= (x ^. _value)
]
replacement in lib/Aftok/Json.hs at line 155

[3.26564]→[3.26564:26622](∅→∅)

qdbProjectJSON = qdbJSON "project" _ProjectId projectJSON

[3.26564]

[3.538]

qdbProjectJSON = qdbJSON "project" (_1 . _ProjectId) (_2 . L.to projectJSON)
replacement in lib/Aftok/Json.hs at line 271

[3.36265]→[3.36265:36570](∅→∅)

v2
$ let widxRec :: (CreditTo (NetworkId, Address), NonEmpty Interval) -> Value
widxRec (c, l) = object
[ "creditTo" .= creditToJSON nmode c
, "intervals" .= (intervalJSON <$> L.toList l)
]
in obj $ ["workIndex" .= fmap widxRec (MS.assocs widx)]

[3.36265]

[3.2061]

v2 $ obj ["workIndex" .= fmap widxRec (MS.assocs widx)]
where
widxRec :: (CreditTo (NetworkId, Address), NonEmpty Interval) -> Value
widxRec (c, l) = object
[ "creditTo" .= creditToJSON nmode c
, "intervals" .= (intervalJSON <$> L.toList l)
]
replacement in lib/Aftok/Json.hs at line 287

[3.25152]→[3.36660:36708](∅→∅)

logEntryJSON nmode (LogEntry c ev m) = v2 $ obj

[3.25152]

[3.36708]

logEntryJSON nmode le = v2 $ obj (logEntryFields nmode le)

logEntryFields :: NetworkMode -> LogEntry (NetworkId, Address) -> [Pair]
logEntryFields nmode (LogEntry c ev m) =
edit in lib/Aftok/Json.hs at line 296

[3.5560]

[3.5560]

keyedLogEntryJSON :: NetworkMode -> (EventId, KeyedLogEntry (NetworkId, Address)) -> Value
keyedLogEntryJSON nmode le = qdbJSON "event" (_1 . _EventId) (_2 . _3 . to (logEntryJSON nmode)) le
replacement in lib/Aftok/Json.hs at line 320

[3.26772]→[3.26772:26836](∅→∅)

qdbBillableJSON = qdbJSON "billable" B._BillableId billableJSON

[3.26772]

[3.1844]

qdbBillableJSON = qdbJSON "billable" (_1 . B._BillableId) (_2 . to billableJSON)
edit in server/Aftok/Snaplet/WorkLog.hs at line 1

[3.5424]

[39.2746]

{-# LANGUAGE TupleSections #-}
replacement in server/Aftok/Snaplet/WorkLog.hs at line 36

[3.5831]→[3.18404:18475](∅→∅)

logWorkHandler :: (C.UTCTime -> LogEvent) -> S.Handler App App EventId

[3.5831]

[3.10122]

logWorkHandler :: (C.UTCTime -> LogEvent) -> S.Handler App App (EventId, KeyedLogEntry BTCNet)
replacement in server/Aftok/Snaplet/WorkLog.hs at line 52

[3.58627]→[3.58627:58697](∅→∅)

Right entry -> snapEval $ createEvent pid uid (entry timestamp)

[3.58627]

[3.570]

Right entry -> do
eid <- snapEval $ createEvent pid uid (entry timestamp)
ev <- snapEval $ findEvent eid
maybe
(snapError 500 $ "An error occured retrieving the newly created event record.")
(pure . (eid,))
ev
replacement in server/Main.hs at line 79

[3.2570]→[3.63768:63844](∅→∅)

logWorkRoute f = serveJSON eventIdJSON $ method POST (logWorkHandler f)

[3.2570]

[3.63844]

logWorkRoute f =
serveJSON (keyedLogEntryJSON nmode) $ method POST (logWorkHandler f)