fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

refactor(schedule): minor cleanup, add debug/info logs

Browse Source
This commit is contained in:
Sarah Vaupel 2020-08-30 15:09:47 +02:00
parent e43009ba0c
commit 2283a881be
1 changed files with 24 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
src/Handler/Schedule.hs
View File

@ -15,7 +15,6 @@ getScheduleR, postScheduleR :: Handler Html
getScheduleR = postScheduleR
postScheduleR = do
uid <- requireAuthId
-- mr <- getMessageRender
mView <- lookupGlobalGetParam GetScheduleView
mOffset <- lookupGlobalGetParam GetScheduleOffset
@ -38,22 +37,26 @@ postScheduleR = do
offsetFromWeekBtn :: ButtonScheduleOffsetWeek -> ScheduleOffset
offsetFromWeekBtn btn = case schedBtnOffset btn of
ScheduleOffsetNone -> ScheduleOffsetNone
offset -> currentScheduleOffset `addOffsets` offset
offset -> currentScheduleOffset `addOffset` offset
scheduleOptionsForm :: MForm (HandlerFor UniWorX) (FormResult ScheduleOptions, Widget)
scheduleOptionsForm = do
(viewRess, viewWidgets) <- fmap unzip . for (universeF :: [ScheduleView]) $ \sView ->
mopt (buttonField sView) ("" { fsName = Just $ toPathPiece GetScheduleView
mreq (buttonField sView) ("" { fsName = Just $ toPathPiece GetScheduleView
, fsAttrs = if sView == currentScheduleView then [("disabled","")] else mempty
}) Nothing
viewRes <- if
| errs@(_:_) <- filter (is _FormFailure) viewRess -> do
| Just errs <- fromNullable (filter (is _FormFailure) viewRess) -> do
mapM_ formFailure2Alerts errs
return $ FormMissing -- TODO: return FormFailure
| all (== FormMissing) viewRess -> return $ FormSuccess currentScheduleView -- TODO: rethink
$logInfoS "SCHEDULE-VIEW" $ "encountered error(s): " <> tshow errs
return FormMissing -- TODO: return FormFailure
| otherwise -> case catMaybes (formResultToMaybe <$> viewRess) of -- TODO: rethink this case
[Just sView] -> return $ FormSuccess sView
_ -> return $ FormSuccess currentScheduleView
[sView] -> do
$logInfoS "SCHEDULE-VIEW" $ "encountered single view result: " <> tshow sView <> ", all results: " <> tshow viewRess
return $ FormSuccess sView
_ -> do
$logInfoS "SCHEDULE-VIEW" $ "encountered no view, all results: " <> tshow viewRess
return $ FormSuccess currentScheduleView
let
offsetBtns = case viewRes of
@ -61,18 +64,22 @@ postScheduleR = do
_ -> mempty
(offsetRess, offsetWidgets) <- fmap unzip . for offsetBtns $ \btn ->
mopt (buttonField btn) ("" { fsName = Just $ toPathPiece GetScheduleOffset
mreq (buttonField btn) ("" { fsName = Just $ toPathPiece GetScheduleOffset
, fsAttrs = if offsetFromWeekBtn btn == currentScheduleOffset then [("disabled","")] else mempty
}) Nothing
offsetRes <- if
| Just errs <- fromNullable (filter (is _FormFailure) offsetRess) -> do
mapM_ formFailure2Alerts errs
return $ FormMissing -- TODO: return FormFailure
| all (== FormMissing) offsetRess -> return $ FormSuccess currentScheduleOffset -- TODO: rethink
$logInfoS "SCHEDULE-OFFSET" $ "encountered error(s): " <> tshow errs
return FormMissing -- TODO: return FormFailure
| otherwise -> case catMaybes (formResultToMaybe <$> offsetRess) of -- TODO: rethink this case
[Just offset] -> return $ FormSuccess $ currentScheduleOffset `addOffsets` (schedBtnOffset offset)
_ -> return $ FormSuccess currentScheduleOffset
[offset] -> do
$logInfoS "SCHEDULE-OFFSET" $ "encountered single offset result: " <> tshow offset <> ", all results: " <> tshow offsetRess
(return . FormSuccess . addOffset currentScheduleOffset . schedBtnOffset) offset
_ -> do
$logInfoS "SCHEDULE-OFFSET" $ "encountered no offset result, all results: " <> tshow offsetRess
return $ FormSuccess currentScheduleOffset
let
scheduleResult = ScheduleOptions <$> viewRes <*> offsetRes
@ -93,7 +100,7 @@ postScheduleR = do
-- | Join two ScheduleOffsets by addition
addOffsets :: ScheduleOffset -> ScheduleOffset -> ScheduleOffset
addOffsets ScheduleOffsetNone offset = offset
addOffsets offset ScheduleOffsetNone = offset
addOffsets (ScheduleOffsetDays d) (ScheduleOffsetDays d') = ScheduleOffsetDays $ d + d'
addOffset :: ScheduleOffset -> ScheduleOffset -> ScheduleOffset
addOffset ScheduleOffsetNone offset = offset
addOffset offset ScheduleOffsetNone = offset
addOffset (ScheduleOffsetDays d) (ScheduleOffsetDays d') = ScheduleOffsetDays $ d + d'