B4MTB6UOH5VPZQ7KDQ23TZSR3CIFGVGVBEFL26LMFAQ5RL7CXPRQC
QAC2QJ32ZLAK25KJ7SWT27WOZKD2MMDE7OZPHIRRFP2W2QZW7PBAC
ZIG57EE6RB22JGB3CT33EN2HVYCHCXBT5GROBTBMBLEMDTGQOOBQC
WRPIYG3EUHZR6N6T74ZXZDXATRMIRLXAQ24UNUNSVTVYGMT2VDSQC
QU5FW67RGCWOWT2YFM4NYMJFFHWIRPQANQBBAHBKZUY7UYMCSIMQC
QMEYU4MWLTSWPWEEOFRLK2IKE64BY3V5X73323WPLCGPP3TPDYGAC
OUR4PAOTXXKXQPMAR5TIYX7MBRRJS2WVTZS7SN4SOGML7SPJIJGQC
JXG3FCXYBDKMUD77DOM7RCIJYKB7BILC43OHHDZBE7YQRGAMUCCAC
NJNMO72S7VIUV22JXB4IFPZMHWTJAOTP6EC6Z4QSKYIROSXT52MQC
2J37EVJMX255K3XEJHTZGRPEIRMAQ62JQWOA7JU3YTZUB6PUPWVQC
IR75ZMX32SFFMDNV2I2L22X5JTWCOC4UUBCSPU7S6VHR6HFV6ADQC
J6S23MDGHVSCVVIRB6XRNSY3EGTDNWFJHV7RYLIEHBUK5KU63CFQC
RB2ETNIFLQUA6OA66DAEOXZ25ENMQGNKX5CZRSKEYHTD6BQ6NTFQC
PT4276XCOP5NJ3GRFJLIBZKVNVAOATAY5PLWV7FWK6RZW5FTEP5AC
let renderOption (Project' p) =
HH.option [P.value $ pidStr p.projectId] [HH.text p.projectName]
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)
]
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 (isNothing st.selectedProject), P.disabled true] [HH.text "Select a project"]]
<> map renderOption st.projects
)
]
where
renderOption (Project' p) =
HH.option
[ P.selected (any (\(Project' p') -> p'.projectId == p.projectId) st.selectedProject)
, P.value $ pidStr p.projectId
]
[HH.text p.projectName]
timeSpan <- TL.Before <$> lift system.nowDateTime -- FIXME, should come from a form control
intervals' <- lift $ caps.listIntervals (unwrap p).projectId timeSpan
intervals <- lift $ case intervals' of
Left err ->
(system.log $ "Error occurred listing intervals" <> show err ) *>
pure []
Right ivals ->
pure $ map (map LoggedEvent) ivals
H.raise (ProjectChange p)
setStateForProject p
history' <- lift <<< runMaybeT $ toHistory system intervals
hist <- case history' of
Nothing -> lift $ system.log "Project history was empty." *> pure M.empty
Just h -> pure h
latestEventResponse <- lift $ caps.getLatestEvent (unwrap p).projectId
now <- lift $ system.now
active <- lift $ case latestEventResponse of
Left err ->
(system.log $ "Error occurred retrieving the latest event: " <> show err) *>
pure Nothing
Right latestEvent -> do
let activeInterval :: TL.KeyedEvent Instant -> m (Maybe (Interval TimelineEvent))
activeInterval ev = case event ev of
TL.StartEvent i ->
(system.log $ "Project has an open active interval starting " <> show i) *>
(Just <<< interval (LoggedEvent ev) <<< PhantomEvent <$> system.now)
TL.StopEvent _ ->
pure Nothing
join <$> traverse activeInterval latestEvent
H.modify_ (_ { selectedProject = Just p, history = hist, active = active })
setStateForProject :: Project -> H.HalogenM TimelineState TimelineAction Slots ProjectEvent m Unit
setStateForProject p = do
timeSpan <- TL.Before <$> lift system.nowDateTime -- FIXME, should come from a form control
intervals' <- lift $ caps.listIntervals (unwrap p).projectId timeSpan
intervals <- lift $ case intervals' of
Left err ->
(system.log $ "Error occurred listing intervals" <> show err ) *>
pure []
Right ivals ->
pure $ map (map LoggedEvent) ivals
history' <- lift <<< runMaybeT $ toHistory system intervals
hist <- case history' of
Nothing -> lift $ system.log "Project history was empty." *> pure M.empty
Just h -> pure h
latestEventResponse <- lift $ caps.getLatestEvent (unwrap p).projectId
now <- lift $ system.now
active <- lift $ case latestEventResponse of
Left err ->
(system.log $ "Error occurred retrieving the latest event: " <> show err) *>
pure Nothing
Right latestEvent -> do
let activeInterval :: TL.KeyedEvent Instant -> m (Maybe (Interval TimelineEvent))
activeInterval ev = case event ev of
TL.StartEvent i ->
(system.log $ "Project has an open active interval starting " <> show i) *>
(Just <<< interval (LoggedEvent ev) <<< PhantomEvent <$> system.now)
TL.StopEvent _ ->
pure Nothing
join <$> traverse activeInterval latestEvent
H.modify_ (_ { selectedProject = Just p, history = hist, active = active })