ZIG57EE6RB22JGB3CT33EN2HVYCHCXBT5GROBTBMBLEMDTGQOOBQC
QU5FW67RGCWOWT2YFM4NYMJFFHWIRPQANQBBAHBKZUY7UYMCSIMQC
WRPIYG3EUHZR6N6T74ZXZDXATRMIRLXAQ24UNUNSVTVYGMT2VDSQC
JXG3FCXYBDKMUD77DOM7RCIJYKB7BILC43OHHDZBE7YQRGAMUCCAC
NJNMO72S7VIUV22JXB4IFPZMHWTJAOTP6EC6Z4QSKYIROSXT52MQC
BFZN4SUAGYNFFYVAP36BAX32DMO622PK4EPEVQQEAGC2IHTEAAPQC
EFSXYZPOGA5M4DN65IEIDO7JK6U34DMQELAPHOIL2UAT6HRC66BAC
IZEVQF627FA7VV25KJAWYWGGC35LZUUBBQRPN5ZAINTQLPEDRTEAC
B6HWAPDPXIWH7CHK5VLMWLL6EQN6NOFZEFYO47BPUY2ZO4SL7VDAC
IPG33FAWXGEQ2PO6OXRT2PWWXHRNMPVUKKADL6UKKN5GD2CNZ25AC
W35DDBFYF6Z4ZPCFEO5RPAONZLYCSNTXUSTS6FIUUVZHCI6Q7GHAC
AL37SVTCKRSG4HG2PCYK5Z7QSIZZH5JHH4Q2VLMXFAXSAQRFFG4QC
EW2XN7KUMCAQNVFJJ5YTAVDZCPHNWDOEDMRFBUGLY6IE2HKNNX5AC
ASF3UPJLCX7KIUCNJD5KAXSPDXCUEJHLL4HBRTRUBPCW73IXOCWQC
Z3MK2PJ5U222DXRS22WCDHVPZ7HVAR3HOCUNXIGX6VMEPBQDF6PQC
O5FVTOM6YFBLEPF3S576K6IMT6ZZ5VQCSB3YVXNS4CKBITKCRZ7AC
GCVQD44VRPQVKPZEPIC4AOIXLJIG2ZMV3QI2Y7KALUT6NVUBSGSAC
O227CEAV7BTKSE3SSC7XHC5IWEBXZL2AOOKJMBMOOFNTLINBLQMAC
BROSTG5KP3NUNLSYPVQID254TE47E5RKQAKLPIY7PGWETE6JNMTAC
4U7F3CPIDTK6JSEDMNMHVKSR7HOQDLZQD2PPVMDLHO5SFSIMUXZAC
HMDM3B557TO5RYP2IGFFC2C2VN6HYZTDQ47CJY2O37BW55DSMFZAC
NEDDHXUK3GNFMOFO3KLU7NRIHCTYNWBT3D6HTKZAOXFDE6HMDZ6AC
UILI6PILCRDPZ3XYA54LGIGPSU7ERWNHCE7R3CE64ZEC7ONOEMOQC
ADMKQQGCGVSHHIMVQ4XFRDCG544SBJCYALSKZV45CQQBZ4ACUH2AC
in HH.select
[E.onSelectedIndexChange (Just <<< Select)]
([HH.option [P.selected true, P.disabled true] [HH.text "Select a project"]] <> map renderOption st.projects)
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)
]
render st =
let lineForm =
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 [])]
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 []))
]
ProjectSelected p ->
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)
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
currentProject <- H.gets (_.selectedProject)
traverse_ logEnd currentProject
lineHtml
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
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]
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)
]
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)]
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)
]
Right entry -> snapEval $ createEvent pid uid (entry timestamp)
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