Add display for prior intervals.

[?]

Aug 22, 2020, 12:20 AM

QMEYU4MWLTSWPWEEOFRLK2IKE64BY3V5X73323WPLCGPP3TPDYGAC

Dependencies

[2] J6S23MDG Use server timestamps for interval start and end.
[3] I2KHGVD4 Require project permissions for access to most data.
[4] BFZN4SUA Make timeline component work.
[5] QMRKFEPG Refactor QDB to use a free monad algebra instead.
[6] AL37SVTC Implement payments service endpoints.
[7] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
[8] HALRDT2F Added initial auction create route.
[9] HO2PFRAB Client login now handles response correctly.
[10] EFSXYZPO Autoformat everything with brittany.
[11] TUA4HMUD Use real API capability for login.
[12] PT4276XC Add logout functionality.
[13] BWN72T44 Don't accept work timestamp from an external source.
[14] RPAJLHMT Change to use UUIDs instead of ints for primary keys.
[15] EZQG2APB Update task list.
[16] TKGBRIQT Login component now raises LoginComplete message.
[17] WZFQDWW4 Add retrieval/storage of current exchange rate data to payment recording.
[18] IPG33FAW Add billing daemon
[19] O722AOKE Add route to allow crediting of events to users/projects.
[20] B6HWAPDP Modularize & update to recent haskoin.
[21] GMYPBCWE Make docker-compose work.
[22] LLKTCDRD Minor reorg of aftok.com paths.
[23] SPJCFHXW Update shell scripts to point to https://aftok.com and prompt for input.
[24] NSRSSSTR Update nginx.conf, make aftok host configurable for cli scripts.
[25] QU5FW67R Add project selection to time tracker.
[26] MGOF7IUF Update TASKS list to reflect completed projects.
[27] 3LMXT7Z6 preventDefault on login form submission.
[28] BROSTG5K Beginning of modularization of server.
[29] JXG3FCXY Upgrade ps + halogen versions.
[30] ZIG57EE6 Fix project selection, end log end on project switch.
[31] NJNMO72S Add zcash.com submodule and update client to modern halogen.
[32] WRPIYG3E Use project listing functionality to check for whether we have a cookie.
[33] EA5BFM5G Split Login component into its own module.
[34] NEDDHXUK Reformat via stylish-haskell
[35] XTBSG4C7 Adding serveJSON combinator to eliminate some boilerplate from handlers.
[36] GCVQD44V Create amends endpoint, switch to UUID primary keys
[37] BSIUHCGF Add payment response handler.
[38] HMDM3B55 Implement core of payments/billing infrastructure.
[39] UOG5H2TW Default work logging credit to logged-in user.
[*] RB2ETNIF Add skeletal PureScript client project.
[*] ARX7SHY5 Begin work on login UI.
[*] PBD7LZYQ Postgres & auth are beginning to function.
[*] 2G3GNDDU Event logging is now functioning in postgres.
[*] ADMKQQGC Initial empty Snap project.

Change contents

edit in client/spago.dhall at line 12

[3.405]

[3.295116]

, "format"
replacement in client/src/Aftok/Login.purs at line 12

[3.295408]→[3.4:30](∅→∅)

import Effect.Class as EC

[3.295408]

[3.86]

import Effect.Class.Console (log)
edit in client/src/Aftok/Login.purs at line 29

[3.295631]

[3.157]

import Aftok.Types (System)
edit in client/src/Aftok/Login.purs at line 32

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

import Effect.Class.Console (log)
replacement in client/src/Aftok/Login.purs at line 63

[3.296122]→[3.81:104](∅→∅),[3.104]→[3.296136:296155](∅→∅),[3.296136]→[3.296136:296155](∅→∅)

. EC.MonadEffect m
=> Capability m

[3.296122]

[3.296155]

. Monad m
=> System m
-> Capability m
replacement in client/src/Aftok/Login.purs at line 67

[3.296208]→[3.296208:296239](∅→∅)

component caps = H.mkComponent

[3.296208]

[3.296239]

component system caps = H.mkComponent
replacement in client/src/Aftok/Login.purs at line 167

[3.173]→[3.173:218](∅→∅)

EC.liftEffect $ WE.preventDefault ev

[3.173]

[3.300306]

lift $ system.preventDefault ev
replacement in client/src/Aftok/Project.purs at line 18

[3.154]→[3.1061:1096](∅→∅),[3.1061]→[3.1061:1096](∅→∅)

import Data.UUID (UUID, parseUUID)

[3.154]

[3.1096]

import Data.UUID (UUID, parseUUID, toString)
replacement in client/src/Aftok/Project.purs at line 27

[3.1287]→[2.82:127](∅→∅)

import Aftok.Types (APIError(..), parseDate)

[3.1287]

[3.216]

import Aftok.Types (APIError(..), System, parseDate)
edit in client/src/Aftok/Project.purs at line 35

[3.332]→[3.113:154](∅→∅),[3.154]→[3.368:369](∅→∅),[3.368]→[3.368:369](∅→∅)

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

[3.199]→[3.199:255](∅→∅)

derive instance newtypeProjectId :: Newtype ProjectId _

[3.199]

[3.404]

derive instance projectIdNewtype :: Newtype ProjectId _
replacement in client/src/Aftok/Project.purs at line 40

[3.435]→[3.435:471](∅→∅)

pidStr (ProjectId uuid) = show uuid

[3.435]

[3.1523]

pidStr (ProjectId uuid) = toString uuid
replacement in client/src/Aftok/Project.purs at line 68

[3.746]→[3.746:787](∅→∅)

. EC.MonadEffect m
=> Capability m

[3.746]

[3.787]

. Monad m
=> System m
-> Capability m
replacement in client/src/Aftok/Project.purs at line 72

[3.834]→[3.834:876](∅→∅)

projectListComponent caps = H.mkComponent

[3.834]

[3.876]

projectListComponent console caps = H.mkComponent
replacement in client/src/Aftok/Project.purs at line 109

[3.1709]→[3.1709:1772](∅→∅)

Left _ -> error "Could not retrieve project list."

[3.1709]

[3.1772]

Left _ -> lift <<< console.error $ "Could not retrieve project list."
replacement in client/src/Aftok/Project.purs at line 114

[3.1902]→[3.868:918](∅→∅)

log $ "Selected project index " <> show i

[3.1902]

[3.918]

lift <<< console.log $ "Selected project index " <> show i
replacement in client/src/Aftok/Timeline.purs at line 7

[2.247]→[2.247:315](∅→∅)

import Control.Monad.Except.Trans (except, withExceptT, runExceptT)

[2.247]

[3.301236]

import Control.Monad.Except.Trans (withExceptT, runExceptT)
replacement in client/src/Aftok/Timeline.purs at line 11

[3.2521]→[3.2521:2546](∅→∅)

import Data.Array (cons)

[3.2521]

[2.316]

import Data.Array (reverse, filter)
replacement in client/src/Aftok/Timeline.purs at line 13

[2.388]→[3.301278:301322](∅→∅),[3.2546]→[3.301278:301322](∅→∅),[3.301322]→[3.2675:2739](∅→∅),[3.2675]→[3.2675:2739](∅→∅)

import Data.DateTime (DateTime(..), adjust)
import Data.DateTime.Instant (Instant, unInstant, fromDateTime)

[2.388]

[2.389]

import Data.Date (Date, year, month, day)
import Data.DateTime (DateTime(..), adjust, date)
import Data.DateTime.Instant (Instant, unInstant, fromDateTime, toDateTime)
replacement in client/src/Aftok/Timeline.purs at line 17

[2.427]→[2.427:487](∅→∅)

import Data.Foldable (class Foldable, any, foldMapDefaultR)

[2.427]

[3.998]

import Data.Enum (fromEnum)
import Data.Foldable (class Foldable, any, foldMapDefaultR, intercalate, foldr, foldl, length)
import Data.JSDate as JD
import Data.Map as M
replacement in client/src/Aftok/Timeline.purs at line 22

[3.1054]→[3.1054:1083](∅→∅)

import Data.Newtype (unwrap)

[3.1054]

[3.2539]

import Data.Newtype (class Newtype, unwrap)
edit in client/src/Aftok/Timeline.purs at line 26

[2.553]

[3.45]

import Data.Tuple (Tuple(..), fst)
edit in client/src/Aftok/Timeline.purs at line 29

[3.2688]→[3.2903:2904](∅→∅),[3.301378]→[3.2903:2904](∅→∅),[3.2903]→[3.2903:2904](∅→∅)
edit in client/src/Aftok/Timeline.purs at line 30

[3.2922]

[3.2922]

import Type.Proxy (Proxy(..))
-- import Text.Format as F -- (format, zeroFill, width)
replacement in client/src/Aftok/Timeline.purs at line 37

[3.301493]→[3.301493:301530](∅→∅)

import Effect.Now (now, nowDateTime)

[3.301493]

[3.3035]

import Effect.Now (now)
replacement in client/src/Aftok/Timeline.purs at line 39

[3.3036]→[3.2689:2764](∅→∅)

import Affjax (post, printError)
import Affjax.StatusCode (StatusCode(..))

[3.3036]

[3.2764]

import Affjax (get, post)
replacement in client/src/Aftok/Timeline.purs at line 55

[3.301702]→[3.114:183](∅→∅)

import CSS (backgroundColor, border, rgb, solid, borderRadius, left)

[3.301702]

[3.301777]

import CSS (backgroundColor, clear, clearBoth, border, rgb, solid, borderRadius, left)
replacement in client/src/Aftok/Timeline.purs at line 61

[3.2907]→[3.2907:2967](∅→∅),[3.2967]→[2.554:599](∅→∅)

import Aftok.Project (Project, Project'(..), ProjectId(..))
import Aftok.Types (APIError(..), parseDate)

[3.2907]

[3.3001]

import Aftok.Project (Project, Project'(..), ProjectId(..), pidStr)
import Aftok.Types (APIError, System, JsonCompose, decompose, parseDatedResponse)
replacement in client/src/Aftok/Timeline.purs at line 64

[3.3002]→[2.600:633](∅→∅)

import Effect.Class.Console as C

[3.3002]

[3.3220]

data Event' i
= StartEvent i
| StopEvent i
replacement in client/src/Aftok/Timeline.purs at line 68

[3.3221]→[3.1084:1100](∅→∅),[3.1100]→[3.3238:3278](∅→∅),[3.3238]→[3.3238:3278](∅→∅)

type Interval =
{ start :: Instant
, end :: Instant

[3.3221]

[3.3278]

type Event = Event' Instant

derive instance eventFunctor :: Functor Event'

instance eventFoldable :: Foldable Event' where
foldr f b = case _ of
StartEvent a -> f a b
StopEvent a -> f a b
foldl f b = case _ of
StartEvent a -> f b a
StopEvent a -> f b a
foldMap = foldMapDefaultR

instance eventTraversable :: Traversable Event' where
traverse f = case _ of
StartEvent a -> StartEvent <$> f a
StopEvent a -> StopEvent <$> f a
sequence = traverse identity

instance decodeJsonEvent :: DecodeJson (Event' String) where
decodeJson json = do
obj <- decodeJson json
event <- obj .: "event"
start' <- traverse (_ .: "eventTime") =<< event .:? "start"
stop' <- traverse (_ .: "eventTime") =<< event .:? "stop"
note "Only 'stop' and 'start' events are supported." $ (StartEvent <$> start') <|> (StopEvent <$> stop')

newtype Interval' i = Interval
{ start :: i
, end :: i
edit in client/src/Aftok/Timeline.purs at line 99

[3.3282]

[3.3282]

derive instance intervalEq :: (Eq i) => Eq (Interval' i)
derive instance intervalNewtype :: Newtype (Interval' i) _

type Interval = Interval' Instant

derive instance intervalFunctor :: Functor Interval'

instance intervalFoldable :: Foldable Interval' where
foldr f b (Interval i) = f i.start (f i.end b)
foldl f b (Interval i) = f (f b i.start) i.end
foldMap = foldMapDefaultR

instance intervalTraversable :: Traversable Interval' where
traverse f (Interval i) = interval <$> f i.start <*> f i.end
sequence = traverse identity

instance decodeJsonInterval :: DecodeJson (Interval' String) where
decodeJson json = do
obj <- decodeJson json
interval <$> obj .: "start" <*> obj .: "end"

interval :: forall i. i -> i -> Interval' i
interval s e = Interval { start: s, end: e }

data TimeSpan' t
= Before t
| During (Interval' t)
| After t

type TimeSpan = TimeSpan' DateTime

derive instance timeSpanFunctor :: Functor TimeSpan'
instance timeSpanFoldable :: Foldable TimeSpan' where
foldr f b = case _ of
Before a -> f a b
During x -> foldr f b x
After a -> f a b
foldl f b = case _ of
Before a -> f b a
During x -> foldl f b x
After a -> f b a
foldMap = foldMapDefaultR

instance timeSpanTraversable :: Traversable TimeSpan' where
traverse f = case _ of
Before a -> Before <$> f a
During x -> During <$> traverse f x
After a -> After <$> f a
sequence = traverse identity
replacement in client/src/Aftok/Timeline.purs at line 151

[3.1123]→[3.301928:301951](∅→∅),[3.3306]→[3.301928:301951](∅→∅)

{ start :: Instant

[3.1123]

[3.3327]

{ bounds :: Interval
edit in client/src/Aftok/Timeline.purs at line 153

[3.3350]→[3.301952:301975](∅→∅)

, end :: Instant
replacement in client/src/Aftok/Timeline.purs at line 157

[3.302006]→[3.3473:3503](∅→∅),[3.3473]→[3.3473:3503](∅→∅)

, history :: Array Interval

[3.302006]

[3.302007]

, history :: M.Map Date (Array Interval)
edit in client/src/Aftok/Timeline.purs at line 171

[3.3157]

[2.634]

| Unexpected String
edit in client/src/Aftok/Timeline.purs at line 176

[2.736]

[3.3157]

Unexpected t -> t
replacement in client/src/Aftok/Timeline.purs at line 187

[3.204]→[3.3274:3336](∅→∅)

{ logStart :: ProjectId -> m (Either TimelineError Instant)

[3.204]

[3.3336]

{ timer :: EventSource m TimelineAction
, logStart :: ProjectId -> m (Either TimelineError Instant)
edit in client/src/Aftok/Timeline.purs at line 190

[3.3396]

[3.254]

, listIntervals :: ProjectId -> TimeSpan -> m (Either TimelineError (Array Interval))
replacement in client/src/Aftok/Timeline.purs at line 194

[3.1170]→[3.3408:3439](∅→∅),[3.3408]→[3.3408:3439](∅→∅),[3.3439]→[3.1171:1191](∅→∅),[3.1191]→[3.3460:3536](∅→∅),[3.3460]→[3.3460:3536](∅→∅),[3.3536]→[3.1192:1229](∅→∅)

:: forall query input output
. Capability Aff
-> Project.Capability Aff
-> H.Component HH.HTML query input output Aff
component caps pcaps = H.mkComponent

[3.1170]

[3.302289]

:: forall query input output m
. Monad m
=> System m
-> Capability m
-> Project.Capability m
-> H.Component HH.HTML query input output m
component system caps pcaps = H.mkComponent
replacement in client/src/Aftok/Timeline.purs at line 210

[3.1336]→[3.3575:3659](∅→∅),[3.302483]→[3.3575:3659](∅→∅)

{ limits: { start: bottom, current: bottom, end: bottom }
, history: []

[3.1336]

[3.3659]

{ limits: { bounds: interval bottom bottom, current: bottom }
, history: M.empty
replacement in client/src/Aftok/Timeline.purs at line 216

[3.4430]→[3.3725:3797](∅→∅)

render :: TimelineState -> H.ComponentHTML TimelineAction Slots Aff

[3.4430]

[3.1337]

render :: TimelineState -> H.ComponentHTML TimelineAction Slots m
replacement in client/src/Aftok/Timeline.purs at line 227

[3.1766]→[3.1766:1815](∅→∅)

[HH.text "Today's project timeline"]

[3.1766]

[3.1815]

[HH.text "Your project timeline"]
replacement in client/src/Aftok/Timeline.purs at line 229

[3.1834]→[3.1834:1955](∅→∅)

[HH.slot _projectList unit (Project.projectListComponent pcaps) unit (Just <<< ProjectSelected)]
]

[3.1834]

[3.1955]

[HH.slot _projectList unit (Project.projectListComponent system pcaps) unit (Just <<< ProjectSelected)]
replacement in client/src/Aftok/Timeline.purs at line 232

[3.2071]→[3.3820:3926](∅→∅),[3.3820]→[3.3820:3926](∅→∅)

[lineHtml (intervalHtml st.limits <$> st.history <> fromMaybe st.active)
,HH.div_

[3.2071]

[3.3926]

([HH.div_
replacement in client/src/Aftok/Timeline.purs at line 234

[3.3951]→[3.3951:4031](∅→∅)

[P.classes (ClassName <$> ["btn", "btn-primary", "float-left"])

[3.3951]

[3.4031]

[P.classes (ClassName <$> ["btn", "btn-primary", "float-left", "my-2"])
replacement in client/src/Aftok/Timeline.purs at line 240

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

[P.classes (ClassName <$> ["btn", "btn-primary", "float-right"])

[3.4157]

[3.4238]

[P.classes (ClassName <$> ["btn", "btn-primary", "float-right", "my-2"])
replacement in client/src/Aftok/Timeline.purs at line 246

[3.303567]→[3.303567:303581](∅→∅)

]

[3.865]

[3.2171]

, lineHtml $ intervalHtml st.limits.bounds <$> currentHistory st
] <> ((\(Tuple d xs) -> dateLine st d xs) <$> priorHistory st))
]
replacement in client/src/Aftok/Timeline.purs at line 251

[3.4813]→[3.5048:5140](∅→∅)

eval :: TimelineAction -> H.HalogenM TimelineState TimelineAction Slots output Aff Unit

[3.4813]

[3.303693]

eval :: TimelineAction -> H.HalogenM TimelineState TimelineAction Slots output m Unit
replacement in client/src/Aftok/Timeline.purs at line 254

[3.303737]→[3.303737:303838](∅→∅),[3.303838]→[3.3394:3446](∅→∅),[3.3446]→[3.303899:303950](∅→∅),[3.303899]→[3.303899:303950](∅→∅),[3.303950]→[3.2182:2203](∅→∅),[3.2203]→[3.303972:304127](∅→∅),[3.303972]→[3.303972:304127](∅→∅),[3.304127]→[3.866:966](∅→∅),[3.966]→[3.304127:304192](∅→∅),[3.304127]→[3.304127:304192](∅→∅)

dt@(DateTime date t) <- liftEffect nowDateTime
let startOfDay = DateTime date bottom
endOfDay = adjust (Days 1.0) startOfDay
startInstant = fromDateTime startOfDay
limits =
{ start: startInstant
, current: fromDateTime dt
, end: maybe startInstant fromDateTime endOfDay
}
llen = ilen limits.start limits.end
clen = ilen limits.start limits.current
H.put $ { limits : limits
, history : []

[3.303737]

[3.304192]

dt@(DateTime today t) <- lift system.nowDateTime
H.put $ { limits : { bounds: dateBounds today
, current: fromDateTime dt
}
, history : M.empty
replacement in client/src/Aftok/Timeline.purs at line 262

[3.304245]→[3.967:998](∅→∅)

_ <- H.subscribe timer

[3.304245]

[3.998]

_ <- H.subscribe caps.timer
replacement in client/src/Aftok/Timeline.purs at line 270

[3.2652]→[2.737:802](∅→∅)

H.modify_ (_ { selectedProject = Just p, history = [] })

[3.2652]

[3.5264]

timeSpan <- Before <$> lift system.nowDateTime -- FIXME, should come from a form control
intervals' <- lift $ caps.listIntervals (unwrap p).projectId timeSpan
let intervals = case intervals' of
Left err -> [] -- FIXME
Right ivals -> ivals
H.modify_ (_ { selectedProject = Just p, history = toHistory intervals })
replacement in client/src/Aftok/Timeline.purs at line 286

[3.304419]→[3.304419:304447](∅→∅)

t <- liftEffect now

[3.304419]

[3.304447]

t <- lift $ system.now
replacement in client/src/Aftok/Timeline.purs at line 289

[3.304478]→[3.2783:2872](∅→∅)

logStart :: Project -> H.HalogenM TimelineState TimelineAction Slots output Aff Unit

[3.304478]

[3.2872]

logStart :: Project -> H.HalogenM TimelineState TimelineAction Slots output m Unit
replacement in client/src/Aftok/Timeline.purs at line 293

[3.2973]→[2.803:869](∅→∅)

Left err -> C.log $ "Failed to start timer: " <> show err

[3.2973]

[3.3020]

Left err -> lift <<< system.log $ "Failed to start timer: " <> show err
replacement in client/src/Aftok/Timeline.purs at line 296

[3.3060]→[3.3060:3147](∅→∅)

logEnd :: Project -> H.HalogenM TimelineState TimelineAction Slots output Aff Unit

[3.3060]

[3.3147]

logEnd :: Project -> H.HalogenM TimelineState TimelineAction Slots output m Unit
replacement in client/src/Aftok/Timeline.purs at line 300

[3.3244]→[2.870:935](∅→∅)

Left err -> C.log $ "Failed to stop timer: " <> show err

[3.3244]

[3.3290]

Left err -> lift <<< system.log $ "Failed to stop timer: " <> show err
edit in client/src/Aftok/Timeline.purs at line 302

[3.3328]

[3.3328]

dateBounds :: Date -> Interval
dateBounds date =
let startOfDay = DateTime date bottom
endOfDay = adjust (Days 1.0) startOfDay
startInstant = fromDateTime startOfDay
in interval startInstant (maybe startInstant fromDateTime endOfDay)

currentHistory
:: TimelineState
-> Array Interval
currentHistory st =
let currentDate = date $ toDateTime st.limits.current
in maybe [] identity (M.lookup currentDate st.history) <> fromMaybe st.active

priorHistory
:: TimelineState
-> Array (Tuple Date (Array Interval))
priorHistory st =
let currentDate = date $ toDateTime st.limits.current
in reverse <<< filter (not <<< (currentDate == _) <<< fst) $ M.toUnfoldable st.history

dateLine
:: forall action slots m
. TimelineState
-> Date
-> Array Interval
-> H.ComponentHTML action slots m
dateLine st d xs =
HH.div
[]
[ HH.text $ dateStr d <> ": " <> show (length xs :: Int)
, lineHtml (intervalHtml (dateBounds d) <$> xs)
]

dateStr :: Date -> String
dateStr d = (show <<< fromEnum $ year d) <> "-"
<> (show <<< fromEnum $ month d) <> "-"
<> (show <<< fromEnum $ day d)
edit in client/src/Aftok/Timeline.purs at line 350

[3.304675]

[3.3467]

clear clearBoth
replacement in client/src/Aftok/Timeline.purs at line 360

[3.304908]→[3.3353:3373](∅→∅)

. TimelineLimits

[3.304908]

[3.3373]

. Interval
replacement in client/src/Aftok/Timeline.purs at line 363

[3.305001]→[3.3388:3412](∅→∅)

intervalHtml limits i =

[3.305001]

[3.1082]

intervalHtml (Interval limits) (Interval i) =
edit in client/src/Aftok/Timeline.purs at line 388

[3.305763]→[2.1053:1936](∅→∅)

data Event i
= StartEvent i
| StopEvent i

derive instance eventFunctor :: Functor Event

instance eventFoldable :: Foldable Event where
foldr f b = case _ of
StartEvent a -> f a b
StopEvent a -> f a b
foldl f b = case _ of
StartEvent a -> f b a
StopEvent a -> f b a
foldMap = foldMapDefaultR

instance eventTraversable :: Traversable Event where
traverse f = case _ of
StartEvent a -> StartEvent <$> f a
StopEvent a -> StopEvent <$> f a
sequence = traverse identity

instance decodeJsonEvent :: DecodeJson (Event String) where
decodeJson json = do
obj <- decodeJson json
event <- obj .: "event"
start' <- traverse (_ .: "eventTime") =<< event .:? "start"
stop' <- traverse (_ .: "eventTime") =<< event .:? "stop"
note "Only 'stop' and 'start' events are supported." $ (StartEvent <$> start') <|> (StopEvent <$> stop')
replacement in client/src/Aftok/Timeline.purs at line 392

[3.3520]→[3.305764:305818](∅→∅),[3.6288]→[3.305764:305818](∅→∅)

s { active = s.active <|> Just { start: t, end: t }

[3.3520]

[3.305818]

s { active = s.active <|> Just (interval t t)
replacement in client/src/Aftok/Timeline.purs at line 397

[3.3532]→[3.305825:305918](∅→∅),[3.6450]→[3.305825:305918](∅→∅)

s { history = maybe s.history (\st -> cons { start: st.start, end: t } s.history) s.active

[3.3532]

[3.305918]

s { history = maybe
s.history
(\i -> M.unionWith (<>) (toHistory [interval (unwrap i).start t]) s.history)
s.active
replacement in client/src/Aftok/Timeline.purs at line 407

[3.1387]→[3.3548:3592](∅→∅)

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

[3.1387]

[3.306012]

, active = map (\(Interval i) -> interval i.start t) s.active
replacement in client/src/Aftok/Timeline.purs at line 418

[3.6171]→[3.6171:6263](∅→∅),[3.6263]→[2.1937:2077](∅→∅),[2.2077]→[3.6378:6410](∅→∅),[3.6378]→[3.6378:6410](∅→∅),[3.6410]→[2.2078:2588](∅→∅)

result <- post RF.json ("/api/projects/" <> UUID.toString pid <> "/logStart") requestBody
liftEffect <<< runExceptT $ case result of
Left err -> throwError <<< LogFailure $ Error { status: Nothing, message: printError err }
Right r -> case r.status of
StatusCode 403 ->
throwError $ LogFailure Forbidden
StatusCode 200 ->
withExceptT (LogFailure <<< ParseFailure r.body) $ do
event <- except $ decodeJson r.body
timeEvent <- traverse parseDate event
case timeEvent of
StartEvent t -> pure $ fromDateTime t
StopEvent _ -> throwError $ "Expected start event, got stop."
other ->
throwError <<< LogFailure $ Error { status: Just other, message: r.statusText }

[3.6171]

[3.6622]

response <- post RF.json ("/api/user/projects/" <> UUID.toString pid <> "/logStart") requestBody
liftEffect <<< runExceptT $ do
event <- withExceptT LogFailure $ parseDatedResponse response
case event of
StartEvent t -> pure t
StopEvent _ -> throwError <<< Unexpected $ "Expected start event, got stop."
replacement in client/src/Aftok/Timeline.purs at line 428

[3.6788]→[3.6788:6878](∅→∅),[3.6878]→[2.2589:2729](∅→∅),[2.2729]→[3.6993:7025](∅→∅),[3.6993]→[3.6993:7025](∅→∅),[3.7025]→[2.2730:3240](∅→∅)

result <- post RF.json ("/api/projects/" <> UUID.toString pid <> "/logEnd") requestBody
liftEffect <<< runExceptT $ case result of
Left err -> throwError <<< LogFailure $ Error { status: Nothing, message: printError err }
Right r -> case r.status of
StatusCode 403 ->
throwError $ LogFailure Forbidden
StatusCode 200 ->
withExceptT (LogFailure <<< ParseFailure r.body) $ do
event <- except $ decodeJson r.body
timeEvent <- traverse parseDate event
case timeEvent of
StartEvent _ -> throwError $ "Expected stop event, got start."
StopEvent t -> pure $ fromDateTime t
other ->
throwError <<< LogFailure $ Error { status: Just other, message: r.statusText }

[3.6788]

[3.7237]

response <- post RF.json ("/api/user/projects/" <> UUID.toString pid <> "/logEnd") requestBody
liftEffect <<< runExceptT $ do
event <- withExceptT LogFailure $ parseDatedResponse response
case event of
StartEvent _ -> throwError <<< Unexpected $ "Expected stop event, got start."
StopEvent t -> pure t

newtype ListIntervalsResponse a = ListIntervalsResponse
{ workIndex :: Array ({ intervals :: Array a })
}

derive instance listIntervalsResponseNewtype :: Newtype (ListIntervalsResponse a) _
derive instance listIntervalsResponseFunctor :: Functor ListIntervalsResponse

instance listIntervalsResponseFoldable :: Foldable ListIntervalsResponse where
foldr f b (ListIntervalsResponse r) = foldr f b (r.workIndex >>= _.intervals)
foldl f b (ListIntervalsResponse r) = foldl f b (r.workIndex >>= _.intervals)
foldMap = foldMapDefaultR

instance listIntervalsResponseTraversable :: Traversable ListIntervalsResponse where
traverse f (ListIntervalsResponse r) =
let traverseCreditRow r' = ({ intervals: _ }) <$> traverse f r'.intervals
in (ListIntervalsResponse <<< ({ workIndex: _ })) <$> traverse traverseCreditRow r.workIndex
sequence = traverse identity

instance listIntervalsResponseDecodeJson :: DecodeJson a => DecodeJson (ListIntervalsResponse a) where
decodeJson = map ListIntervalsResponse <<< decodeJson

_ListIntervalsResponse :: Proxy (JsonCompose ListIntervalsResponse Interval' String)
_ListIntervalsResponse = Proxy

apiListIntervals :: ProjectId -> TimeSpan -> Aff (Either TimelineError (Array Interval))
apiListIntervals pid ts = do
ts' <- liftEffect $ traverse (JD.toISOString <<< JD.fromDateTime) ts
let queryElements = case ts' of
Before t -> ["before=" <> t]
During (Interval x) -> ["after=" <> x.start, "before=" <> x.end]
After t -> ["after=" <> t]
response <- get RF.json ("/api/user/projects/" <> pidStr pid <> "/workIndex?" <> intercalate "&" queryElements)
liftEffect
<<< runExceptT
<<< map (\(ListIntervalsResponse r) -> r.workIndex >>= (_.intervals))
<<< map decompose
<<< withExceptT LogFailure
$ parseDatedResponse response
replacement in client/src/Aftok/Timeline.purs at line 476

[3.7270]→[3.3803:3864](∅→∅)

apiCapability = { logStart: apiLogStart, logEnd: apiLogEnd }

[3.7270]

[3.7307]

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

[3.3882]→[3.7309:7354](∅→∅),[3.1484]→[3.7309:7354](∅→∅)

{ logStart: \_ -> Right <$> liftEffect now

[3.3882]

[3.7354]

{ timer: timer
, logStart: \_ -> Right <$> liftEffect now
edit in client/src/Aftok/Timeline.purs at line 488

[3.7398]

[3.1540]

, listIntervals: \_ _ -> Right <$> pure []
edit in client/src/Aftok/Timeline.purs at line 490

[3.1544]

intervalDate :: Interval -> Date
intervalDate = date <<< toDateTime <<< (_.end) <<< unwrap

toHistory :: Array Interval -> M.Map Date (Array Interval)
toHistory = M.fromFoldableWith (<>) <<< map (\i -> Tuple (intervalDate i) [i])
edit in client/src/Aftok/Types.purs at line 5

[2.3259]

[2.3259]

import Control.Monad.Error.Class (throwError)
import Control.Monad.Except.Trans (ExceptT, except, withExceptT)
edit in client/src/Aftok/Types.purs at line 8

[2.3299]→[2.3299:3351](∅→∅)

import Control.Monad.Except.Trans (ExceptT, except)
replacement in client/src/Aftok/Types.purs at line 10

[2.3396]→[2.3396:3437](∅→∅)

import Data.Argonaut.Decode (decodeJson)

[2.3396]

[2.3437]

import Data.Argonaut.Decode (class DecodeJson, decodeJson)
replacement in client/src/Aftok/Types.purs at line 12

[2.3469]→[2.3469:3495](∅→∅)

import Data.Either (note)

[2.3469]

[2.3495]

import Data.DateTime.Instant (Instant, fromDateTime)
import Data.Functor.Compose (Compose(..))
import Data.Either (Either(..), note)
import Data.Foldable (class Foldable, foldr, foldl, foldMap)
replacement in client/src/Aftok/Types.purs at line 17

[2.3524]→[3.7460:7486](∅→∅),[3.7460]→[3.7460:7486](∅→∅)

import Data.Maybe (Maybe)

[2.3524]

[2.3525]

import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype, unwrap, over)
import Data.Traversable (class Traversable, traverse)
replacement in client/src/Aftok/Types.purs at line 22

[2.3549]→[3.7486:7524](∅→∅),[3.7486]→[3.7486:7524](∅→∅)

import Affjax.StatusCode (StatusCode)

[2.3549]

[3.7524]

import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Now (now, nowDateTime)
import Affjax as AJAX
import Affjax (Response, printError)
import Affjax.StatusCode (StatusCode(..))

import Effect.Class.Console as C
import Web.Event.Event as WE
edit in client/src/Aftok/Types.purs at line 32

[3.7525]

[3.7525]

type System m =
{ log :: String -> m Unit
, error :: String -> m Unit
, now :: m Instant
, nowDateTime :: m DateTime
, preventDefault :: WE.Event -> m Unit
}

liveSystem :: System Aff
liveSystem =
{ log: liftEffect <<< C.log
, error: liftEffect <<< C.error
, now: liftEffect now
, nowDateTime: liftEffect nowDateTime
, preventDefault: liftEffect <<< WE.preventDefault
}
edit in client/src/Aftok/Types.purs at line 59

[2.3815]

[2.3815]

newtype JsonCompose f g a = JsonCompose (Compose f g a)
derive instance jsonComposeNewtype :: Newtype (JsonCompose f g a) _

instance jsonComposeFunctor :: (Functor f, Functor g) => Functor (JsonCompose f g) where
map f = over JsonCompose (map f)
edit in client/src/Aftok/Types.purs at line 66

[2.3816]

[2.3816]

instance jsonComposeFoldable :: (Foldable f, Foldable g) => Foldable (JsonCompose f g) where
foldr f b = foldr f b <<< unwrap
foldl f b = foldl f b <<< unwrap
foldMap f = foldMap f <<< unwrap

instance jsonComposeTraversable :: (Traversable f, Traversable g) => Traversable (JsonCompose f g) where
traverse f = map JsonCompose <<< traverse f <<< unwrap
sequence = traverse identity

instance jsonComposeDecodeJson :: (DecodeJson (f (g a))) => DecodeJson (JsonCompose f g a) where
decodeJson json = JsonCompose <<< Compose <$> decodeJson json

decompose :: forall f g a. JsonCompose f g a -> f (g a)
decompose (JsonCompose (Compose fga)) = fga
edit in client/src/Aftok/Types.purs at line 91

[2.4195]

[2.4195]

decodeDatedJson :: forall t. Traversable t => DecodeJson (t String) => Json -> ExceptT String Effect (t DateTime)
decodeDatedJson json = do
decoded <- except $ decodeJson json
traverse parseDate decoded
edit in client/src/Aftok/Types.purs at line 97

[2.4196]

parseDatedResponse
:: forall t
. Traversable t
=> DecodeJson (t String)
=> Either AJAX.Error (Response Json)
-> ExceptT APIError Effect (t Instant)
parseDatedResponse = case _ of
Left err ->
throwError $ Error { status: Nothing, message: printError err }
Right r -> case r.status of
StatusCode 403 ->
throwError $ Forbidden
StatusCode 200 ->
withExceptT (ParseFailure r.body) $ map fromDateTime <$> decodeDatedJson r.body
other ->
throwError $ Error { status: Just other, message: r.statusText }
edit in client/src/Main.purs at line 11

[3.307589]→[3.307589:307613](∅→∅)

import Effect.Aff (Aff)
edit in client/src/Main.purs at line 22

[42.1095]

[3.307686]

import Aftok.Types (System, liveSystem)
replacement in client/src/Main.purs at line 34

[3.3826]→[3.1486:1541](∅→∅)

mainComponent = component login timeline project

[3.3826]

[3.1541]

mainComponent = component liveSystem login timeline project
replacement in client/src/Main.purs at line 56

[3.308288]→[3.308288:308345](∅→∅),[3.308345]→[3.1759:1788](∅→∅),[3.1788]→[3.3952:3980](∅→∅),[3.1788]→[3.308345:308393](∅→∅),[3.3980]→[3.308345:308393](∅→∅),[3.308345]→[3.308345:308393](∅→∅),[3.308393]→[3.3981:4028](∅→∅)

:: forall query input output
. Login.Capability Aff
-> Timeline.Capability Aff
-> Project.Capability Aff
-> H.Component HH.HTML query input output Aff
component loginCap tlCap pCap = H.mkComponent

[3.308288]

[3.308429]

:: forall query input output m
. Monad m
=> System m
-> Login.Capability m
-> Timeline.Capability m
-> Project.Capability m
-> H.Component HH.HTML query input output m
component system loginCap tlCap pCap = H.mkComponent
replacement in client/src/Main.purs at line 74

[3.308599]→[3.308599:308663](∅→∅)

render :: MainState -> H.ComponentHTML MainAction Slots Aff

[3.308599]

[3.308663]

render :: MainState -> H.ComponentHTML MainAction Slots m
replacement in client/src/Main.purs at line 81

[3.1721]→[3.1721:1812](∅→∅)

[ HH.slot _login unit (Login.component loginCap) unit (Just <<< LoginComplete) ]

[3.1721]

[3.1812]

[ HH.slot _login unit (Login.component system loginCap) unit (Just <<< LoginComplete) ]
replacement in client/src/Main.purs at line 85

[3.1844]→[3.7723:7804](∅→∅)

[ HH.slot _timeline unit (Timeline.component tlCap pCap) unit absurd ]

[3.1844]

[3.308924]

[ HH.slot _timeline unit (Timeline.component system tlCap pCap) unit absurd ]
replacement in client/src/Main.purs at line 87

[3.308925]→[3.308925:309005](∅→∅)

eval :: MainAction -> H.HalogenM MainState MainAction Slots output Aff Unit

[3.308925]

[3.309005]

eval :: MainAction -> H.HalogenM MainState MainAction Slots output m Unit
file addition: list_intervals.sh (---r------)

[43.1220]

#!/bin/bash

if [ -f ".env" ]; then
source .env
fi

if [ -z "${AFTOK_HOST}" ]; then
AFTOK_HOST="aftok.com"
fi

if [ -z "${USER}" ]; then
read -p "Username: " USER
echo
fi

if [ -z "${PID}" ]; then
read -p "Project UUID: " PID
echo
fi

curl --verbose --insecure --user $USER \
--request GET \
"https://$AFTOK_HOST/api/projects/$PID/intervals"
replacement in scripts/log_end.sh at line 24

[3.1202]→[3.1194:1244](∅→∅)

"https://$AFTOK_HOST/api/projects/$PID/logEnd"

[3.1202]

"https://$AFTOK_HOST/api/user/projects/$PID/logEnd"
replacement in scripts/log_start.sh at line 24

[3.1376]→[3.1309:1360](∅→∅)

"https://$AFTOK_HOST/api/projects/$PID/logStart"

[3.1376]

"https://$AFTOK_HOST/api/user/projects/$PID/logStart"
replacement in server/Aftok/Snaplet/WorkLog.hs at line 81

[3.6348]→[3.35930:36007](∅→∅),[3.1618]→[3.3428:3456](∅→∅),[3.18605]→[3.3428:3456](∅→∅),[3.36007]→[3.3428:3456](∅→∅),[3.6393]→[3.3428:3456](∅→∅)

loggedIntervalsHandler :: S.Handler App App (WorkIndex (NetworkId, Address))
loggedIntervalsHandler = do

[3.6348]

[3.12852]

projectWorkIndex :: S.Handler App App (WorkIndex (NetworkId, Address))
projectWorkIndex = do
replacement in server/Aftok/Snaplet/WorkLog.hs at line 87

[3.6632]→[3.36008:36079](∅→∅),[3.18656]→[3.4907:4930](∅→∅),[3.36079]→[3.4907:4930](∅→∅),[3.4907]→[3.4907:4930](∅→∅)

logEntriesHandler :: S.Handler App App [LogEntry (NetworkId, Address)]
logEntriesHandler = do

[3.6632]

[3.59080]

userLogEntries :: S.Handler App App [LogEntry (NetworkId, Address)]
userLogEntries = do
replacement in server/Aftok/Snaplet/WorkLog.hs at line 98

[3.59348]→[3.59348:59425](∅→∅)

"You must at least one of the \"after\" or \"before\" query parameter"

[3.59348]

[3.12987]

"You must specify at least one of the \"after\" or \"before\" query parameters"
edit in server/Aftok/Snaplet/WorkLog.hs at line 101

[3.5386]

[3.36080]

userWorkIndex :: S.Handler App App (WorkIndex (NetworkId, Address))
userWorkIndex =
workIndex <$> userLogEntries
replacement in server/Main.hs at line 71

[3.8384]→[3.63422:63689](∅→∅)

projectRoute = serveJSON projectJSON $ method GET projectGetHandler
logEntriesRoute =
serveJSON (fmap $ logEntryJSON nmode) $ method GET logEntriesHandler
logIntervalsRoute =
serveJSON (workIndexJSON nmode) $ method GET loggedIntervalsHandler

[3.8384]

[3.2549]

projectRoute =
serveJSON projectJSON $ method GET projectGetHandler
projectWorkIndexRoute =
serveJSON (workIndexJSON nmode) $ method GET projectWorkIndex
replacement in server/Main.hs at line 76

[3.2550]→[3.63690:63767](∅→∅)

payoutsRoute = serveJSON (payoutsJSON nmode) $ method GET payoutsHandler

[3.2550]

[3.2569]

projectPayoutsRoute = serveJSON (payoutsJSON nmode) $ method GET payoutsHandler
replacement in server/Main.hs at line 80

[3.5806]→[3.63844:64011](∅→∅),[3.63844]→[3.63844:64011](∅→∅)

logWorkBTCRoute f =
serveJSON eventIdJSON $ method POST (logWorkBTCHandler f)
amendEventRoute = serveJSON amendmentIdJSON $ method PUT amendEventHandler

[3.5806]

[3.317]

-- logWorkBTCRoute f =
-- serveJSON eventIdJSON $ method POST (logWorkBTCHandler f)
amendEventRoute =
serveJSON amendmentIdJSON $ method PUT amendEventHandler
userLogEntriesRoute =
serveJSON (fmap $ logEntryJSON nmode) $ method GET userLogEntries
userWorkIndexRoute =
serveJSON (workIndexJSON nmode) $ method GET userWorkIndex
replacement in server/Main.hs at line 119

[3.65217]→[3.65217:66061](∅→∅)

, ("projects/:projectId/logStart/:btcAddr", logWorkBTCRoute StartWork)
, ("projects/:projectId/logEnd/:btcAddr", logWorkBTCRoute StopWork)
, ("projects/:projectId/logStart" , logWorkRoute StartWork)
, ("projects/:projectId/logEnd" , logWorkRoute StopWork)
, ("projects/:projectId/logEntries" , logEntriesRoute)
, ("projects/:projectId/intervals" , logIntervalsRoute)
, ( "projects/:projectId/auctions"
, auctionCreateRoute
) -- <|> auctionListRoute
, ( "projects/:projectId/billables"
, billableCreateRoute <|> billableListRoute
)
, ("projects/:projectId/payouts", payoutsRoute)
, ("projects/:projectId/invite" , inviteRoute)
, ("projects/:projectId" , projectRoute)
, ("projects" , projectCreateRoute <|> projectListRoute)

[3.65217]

[3.66061]

-- , ("projects/:projectId/logStart/:btcAddr" , logWorkBTCRoute StartWork)
-- , ("projects/:projectId/logEnd/:btcAddr" , logWorkBTCRoute StopWork)
, ("user/projects/:projectId/logStart" , logWorkRoute StartWork)
, ("user/projects/:projectId/logEnd" , logWorkRoute StopWork)
, ("user/projects/:projectId/logEntries" , userLogEntriesRoute)
, ("user/projects/:projectId/workIndex" , userWorkIndexRoute)
, ("projects/:projectId/workIndex" , projectWorkIndexRoute)
, ("projects/:projectId/auctions" , auctionCreateRoute) -- <|> auctionListRoute)
, ("projects/:projectId/billables" , billableCreateRoute <|> billableListRoute)
, ("projects/:projectId/payouts" , projectPayoutsRoute)
, ("projects/:projectId/invite" , inviteRoute)
, ("projects/:projectId" , projectRoute)
, ("projects" , projectCreateRoute <|> projectListRoute)