Add project selection to time tracker.

[?]

Aug 19, 2020, 5:10 AM

QU5FW67RGCWOWT2YFM4NYMJFFHWIRPQANQBBAHBKZUY7UYMCSIMQC

Dependencies

[2] PT4276XC Add logout functionality.
[3] UOG5H2TW Default work logging credit to logged-in user.
[4] XJ4EYMIH Let curl prompt for http password, rather than bash.
[5] TKGBRIQT Login component now raises LoginComplete message.
[6] WRPIYG3E Use project listing functionality to check for whether we have a cookie.
[7] E7GQXOID Allow the use of a local .env file to store username/project ID for UI scripts.
[8] CDHZL3RP Add a couple of other CLI utilities for interacing with the service.
[9] NSRSSSTR Update nginx.conf, make aftok host configurable for cli scripts.
[10] NJNMO72S Add zcash.com submodule and update client to modern halogen.
[11] TUA4HMUD Use real API capability for login.
[12] JXG3FCXY Upgrade ps + halogen versions.
[13] BFZN4SUA Make timeline component work.
[14] EA5BFM5G Split Login component into its own module.
[*] RB2ETNIF Add skeletal PureScript client project.

Change contents

replacement in client/src/Aftok/Login.purs at line 78

[3.296580]→[3.296580:296642](∅→∅)

[ P.classes (ClassName <$> ["row", "no-gutters"]) ]

[3.296580]

[3.296642]

[ P.classes (ClassName <$> ["row", "no-gutters", "container"]) ]
edit in client/src/Aftok/Project.purs at line 9

[3.728]

[3.728]

import Data.Array (index)
edit in client/src/Aftok/Project.purs at line 16

[3.954]→[3.954:996](∅→∅)

-- import Data.HTTP.Method (Method(POST))
replacement in client/src/Aftok/Project.purs at line 17

[3.1026]→[3.1026:1061](∅→∅)

import Data.Traversable (traverse)

[3.1026]

[3.1061]

import Data.Traversable (traverse, traverse_)
replacement in client/src/Aftok/Project.purs at line 22

[3.1144]→[3.1144:1177](∅→∅)

import Effect.Class (liftEffect)

[3.1144]

[3.1177]

import Effect.Class as EC
replacement in client/src/Aftok/Project.purs at line 27

[3.1287]→[3.1287:1523](∅→∅)

-- import Halogen as H
-- import Halogen.HTML.Core (ClassName(..))
-- import Halogen.HTML as HH
-- import Halogen.HTML.CSS as CSS
-- import Halogen.HTML.Events as E
-- import Web.Event.Event as WE
-- import Halogen.HTML.Properties as P

[3.1287]

[3.1523]

import Aftok.Types (APIError(..))

import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as E
import Halogen.HTML.Properties as P

import Effect.Class.Console (error)

newtype ProjectId = ProjectId UUID

pidStr :: ProjectId -> String
pidStr (ProjectId uuid) = show uuid
replacement in client/src/Aftok/Project.purs at line 42

[3.1557]→[3.1557:1583](∅→∅)

{ projectName :: String

[3.1557]

[3.1583]

{ projectId :: ProjectId
, projectName :: String
edit in client/src/Aftok/Project.purs at line 49

[3.1669]

[3.1669]

type ProjectCState =
{ projects :: Array Project
}

data ProjectAction
= Initialize
| Select Int

type ProjectListSlot id = forall query. H.Slot query Project id
replacement in client/src/Aftok/Project.purs at line 64

[3.1751]→[3.1751:1869](∅→∅)

data APIError
= Forbidden
| ParseFailure Json String
| Error { status :: Maybe StatusCode, message :: String }

[3.1751]

[3.1869]

projectListComponent
:: forall query input m
. EC.MonadEffect m
=> Capability m
-> H.Component HH.HTML query input Project m
projectListComponent caps = H.mkComponent
{ initialState
, render
, eval: H.mkEval $ H.defaultEval
{ handleAction = eval
, initialize = Just Initialize
}
} where

initialState :: input -> ProjectCState
initialState _ = { projects: [] }

render :: forall slots. ProjectCState -> H.ComponentHTML ProjectAction slots m
render st =
let renderOption (Project' p) =
HH.option [P.value $ pidStr p.projectId] [HH.text p.projectName]
in HH.select
[E.onSelectedIndexChange (Just <<< Select)]
([HH.option [P.selected true, P.disabled true] [HH.text "Select a project"]] <> map renderOption st.projects)

eval :: ProjectAction -> H.HalogenM ProjectCState ProjectAction () Project m Unit
eval = case _ of
Initialize -> do
res <- lift caps.listProjects
case res of
Left _ -> error "Could not retrieve project list."
Right projects -> H.modify_ (_ { projects = projects })

Select i -> do
projects <- H.gets (_.projects)
traverse_ H.raise (index projects i)
replacement in client/src/Aftok/Project.purs at line 105

[3.1983]→[3.1983:2246](∅→∅)

projectName <- x .: "projectName"
inceptionDate <- x .: "inceptionDate"
initiatorStr <- x .: "initiator"
initiator <- note "Failed to decode initiator UUID" $ parseUUID initiatorStr
pure $ Project' { projectName, inceptionDate, initiator }

[3.1983]

[3.2246]

project <- x .: "project"

projectIdStr <- x .: "projectId"
projectId <- ProjectId <$> (note "Failed to decode project UUID" $ parseUUID projectIdStr)
edit in client/src/Aftok/Project.purs at line 110

[3.2247]

[3.2247]

projectName <- project .: "projectName"
inceptionDate <- project .: "inceptionDate"
initiatorStr <- project .: "initiator"
initiator <- note "Failed to decode initiator UUID" $ parseUUID initiatorStr
pure $ Project' { projectId, projectName, inceptionDate, initiator }
replacement in client/src/Aftok/Project.purs at line 119

[3.2361]→[3.2361:2406](∅→∅)

liftEffect <<< runExceptT $ case result of

[3.2361]

[3.2406]

EC.liftEffect <<< runExceptT $ case result of
replacement in client/src/Aftok/Timeline.purs at line 12

[3.2866]→[3.2866:2903](∅→∅)

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

[3.2739]

[3.45]

import Data.Either (Either(..))
import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Symbol (SProxy(..))
import Data.Time.Duration (Milliseconds(..), Days(..))
import Data.Traversable (traverse_)
replacement in client/src/Aftok/Timeline.purs at line 18

[3.80]→[3.301323:301378](∅→∅),[3.2903]→[3.301323:301378](∅→∅)

import Data.Time.Duration (Milliseconds(..), Days(..))

[3.80]

[3.2903]

import Data.UUID as UUID
edit in client/src/Aftok/Timeline.purs at line 28

[3.3036]

[3.3036]

import Affjax (post, printError)
import Affjax.StatusCode (StatusCode(..))
import Affjax.RequestBody as RB
import Affjax.ResponseFormat as RF

import Data.Argonaut.Encode (encodeJson)
replacement in client/src/Aftok/Timeline.purs at line 50

[3.301880]→[3.301880:301927](∅→∅)

type TimelineConfig =
{ width :: Number
}

[3.301880]

[3.3220]

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

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

[3.302037]

[3.3532]

, selectedProject :: Maybe Project
edit in client/src/Aftok/Timeline.purs at line 76

[3.302073]

[3.302073]

| ProjectSelected Project.Project
edit in client/src/Aftok/Timeline.purs at line 81

[3.3626]

[3.302105]

data TimelineError
= LogFailure (APIError)
edit in client/src/Aftok/Timeline.purs at line 86

[3.3688]

[3.184]

type Slots =
( projectList :: Project.ProjectListSlot Unit
)

_projectList = SProxy :: SProxy "projectList"
replacement in client/src/Aftok/Timeline.purs at line 93

[3.204]→[3.204:254](∅→∅)

{ logStart :: m Instant
, logEnd :: m Instant

[3.204]

[3.254]

{ logStart :: ProjectId -> m (Either TimelineError Instant)
, logEnd :: ProjectId -> m (Either TimelineError Instant)
replacement in client/src/Aftok/Timeline.purs at line 97

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

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

[3.259]

[3.302289]

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

[3.302483]→[3.302483:302638](∅→∅)

let limits = { start: bottom, current: bottom, end: bottom }
history = []
active = Nothing
in { limits, history, active }

[3.302483]

[3.4429]

{ limits: { start: bottom, current: bottom, end: bottom }
, history: []
, active: Nothing
, selectedProject: Nothing
}
replacement in client/src/Aftok/Timeline.purs at line 118

[3.4430]→[3.416:502](∅→∅)

render :: forall slots m. TimelineState -> H.ComponentHTML TimelineAction slots m

[3.4430]

[3.302724]

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

[3.302741]→[3.302741:303205](∅→∅),[3.303205]→[3.503:591](∅→∅),[3.591]→[3.303270:303312](∅→∅),[3.303270]→[3.303270:303312](∅→∅),[3.303312]→[3.592:728](∅→∅),[3.728]→[3.303391:303451](∅→∅),[3.303391]→[3.303391:303451](∅→∅),[3.303451]→[3.729:849](∅→∅)

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"]
,lineHtml (intervalHtml conf st.limits <$> st.history <> fromMaybe st.active)
,HH.div_
[HH.button
[P.classes (ClassName <$> ["btn", "btn-primary", "float-left"])
,E.onClick \_ -> Just Start
]
[HH.text "Start Work"]
,HH.button
[P.classes (ClassName <$> ["btn", "btn-primary", "float-right"])
,E.onClick \_ -> Just Stop

[3.302741]

[3.849]

let lineForm =
[lineHtml (intervalHtml st.limits <$> st.history <> fromMaybe st.active)
,HH.div_
[HH.button
[P.classes (ClassName <$> ["btn", "btn-primary", "float-left"])
,E.onClick \_ -> Just Start
]
[HH.text "Start Work"]
,HH.button
[P.classes (ClassName <$> ["btn", "btn-primary", "float-right"])
,E.onClick \_ -> Just Stop
]
[HH.text "Stop Work"]
edit in client/src/Aftok/Timeline.purs at line 134

[3.865]→[3.303531:303567](∅→∅),[3.303531]→[3.303531:303567](∅→∅)

[HH.text "Stop Work"]
replacement in client/src/Aftok/Timeline.purs at line 135

[3.303581]→[3.303581:303603](∅→∅)

]
]

[3.303581]

[3.4812]

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 []))
replacement in client/src/Aftok/Timeline.purs at line 150

[3.4813]→[3.303604:303693](∅→∅)

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

[3.4813]

[3.303693]

eval :: TimelineAction -> H.HalogenM TimelineState TimelineAction Slots output Aff Unit
edit in client/src/Aftok/Timeline.purs at line 167

[3.304227]

[3.304227]

, selectedProject: Nothing
edit in client/src/Aftok/Timeline.purs at line 172

[3.5215]

[3.304246]

ProjectSelected p ->
H.modify_ (_ { selectedProject = Just p })
replacement in client/src/Aftok/Timeline.purs at line 176

[3.304266]→[3.1017:1050](∅→∅),[3.1050]→[3.304294:304322](∅→∅),[3.304294]→[3.304294:304322](∅→∅)

t <- lift caps.logStart
H.modify_ (start t)

[3.304266]

[3.304322]

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)
project <- H.gets (_.selectedProject)
log $ "Project selected? " <> show (isJust project)
traverse_ withProject project
replacement in client/src/Aftok/Timeline.purs at line 186

[3.304343]→[3.1051:1081](∅→∅),[3.1081]→[3.304371:304398](∅→∅),[3.304371]→[3.304371:304398](∅→∅)

t <- lift caps.logEnd
H.modify_ (stop t)

[3.304343]

[3.304398]

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
replacement in client/src/Aftok/Timeline.purs at line 215

[3.304908]→[3.304908:304950](∅→∅)

. TimelineConfig
-> TimelineLimits

[3.304908]

[3.304950]

. TimelineLimits
replacement in client/src/Aftok/Timeline.purs at line 218

[3.305001]→[3.305001:305031](∅→∅)

intervalHtml conf limits i =

[3.305001]

[3.1082]

intervalHtml limits i =
edit in client/src/Aftok/Timeline.purs at line 267

[3.6890]

[3.1433]

logStart :: ProjectId -> Aff (Either TimelineError Instant)
logStart (ProjectId pid) = do
let requestBody = Just <<< RB.Json <<< encodeJson $ { schemaVersion: "2.0" }
result <- post RF.json ("/api/projects/" <> UUID.toString pid <> "/logStart") requestBody
case result of
Left err -> pure <<< Left <<< LogFailure $ Error { status: Nothing, message: printError err }
Right r -> case r.status of
StatusCode 403 -> pure <<< Left <<< LogFailure $ Forbidden
StatusCode 200 -> Right <$> liftEffect now
other -> pure <<< Left <<< LogFailure $ Error { status: Just other, message: r.statusText }

logEnd :: ProjectId -> Aff (Either TimelineError Instant)
logEnd (ProjectId pid) = do
let requestBody = Just <<< RB.Json <<< encodeJson $ { schemaVersion: "2.0" }
result <- post RF.json ("/api/projects/" <> UUID.toString pid <> "/logEnd") requestBody
case result of
Left err -> pure <<< Left <<< LogFailure $ Error { status: Nothing, message: printError err }
Right r -> case r.status of
StatusCode 403 -> pure <<< Left <<< LogFailure $ Forbidden
StatusCode 200 -> Right <$> liftEffect now
other -> pure <<< Left <<< LogFailure $ Error { status: Just other, message: r.statusText }

apiCapability :: Capability Aff
apiCapability = { logStart, logEnd }
replacement in client/src/Aftok/Timeline.purs at line 294

[3.1484]→[3.1484:1540](∅→∅)

{ logStart: liftEffect now
, logEnd: liftEffect now

[3.1484]

[3.1540]

{ logStart: \_ -> Right <$> liftEffect now
, logEnd: \_ -> Right <$> liftEffect now
file addition: Types.purs (----------)

[3.1]

module Aftok.Types where

import Data.Argonaut.Core (Json)
import Data.Maybe (Maybe)
import Affjax.StatusCode (StatusCode)

data APIError
= Forbidden
| ParseFailure Json String
| Error { status :: Maybe StatusCode, message :: String }
replacement in client/src/Main.purs at line 32

[3.1617]→[3.1617:1658](∅→∅)

timeline = Timeline.mockCapability

[3.1617]

[3.3788]

timeline = Timeline.apiCapability
replacement in client/src/Main.purs at line 83

[2.1844]→[2.1844:1937](∅→∅)

[ HH.slot _timeline unit (Timeline.component tlCap { width: 600.0 }) unit absurd ]

[2.1844]

[3.308924]

[ HH.slot _timeline unit (Timeline.component tlCap pCap) unit absurd ]
replacement in scripts/list_projects.sh at line 16

[3.71]→[3.821:862](∅→∅)

curl --verbose --insecure --user $USER \

[3.71]

[3.959]

curl --insecure --user $USER \