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 handler code cleanup

Browse Source
This commit is contained in:
Sarah Vaupel 2020-10-23 14:53:54 +02:00
parent ae753e5a4f
commit 2c021d0ae2
1 changed files with 15 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
src/Handler/Schedule.hs
View File

@ -30,21 +30,16 @@ postScheduleR = do
currentScheduleOptions :: ScheduleOptions
currentScheduleOptions = fromMaybe defaultScheduleOptions mOptions
currentScheduleView :: ScheduleView
currentScheduleView = scheduleView currentScheduleOptions
currentScheduleOffset :: ScheduleOffset
currentScheduleOffset = scheduleOffset currentScheduleOptions
currentScheduleOptionsAction :: ScheduleOptionsAction
currentScheduleOptionsAction = scheduleOptionsAction currentScheduleOptions
scheduleOptionsForm :: Html -> MForm (HandlerFor UniWorX) (FormResult ScheduleOptions, Widget)
scheduleOptionsForm csrf = do
(viewRess, viewWidgets) <- fmap unzip . for (universeF :: [ScheduleView]) $ \scheduleView ->
mopt (buttonField ScheduleOptions{scheduleOffset=ScheduleOffsetNone,scheduleOptionsAction=ScheduleSetView,..})
(viewRess, viewWidgets) <- fmap unzip . for (universeF :: [ScheduleView]) $ \sView ->
mopt (buttonField ScheduleOptions
{ scheduleView = sView
, scheduleOffset = ScheduleOffsetNone
, scheduleOptionsAction = ScheduleSetView
})
("" { fsName = Just $ toPathPiece GetScheduleOptions
, fsAttrs = if scheduleView == currentScheduleView then [("disabled","")] else mempty
, fsAttrs = if sView == scheduleView currentScheduleOptions then [("disabled","")] else mempty
}) Nothing
viewRes <- if
-- TODO: ignoring FormFailures for now
@ -53,16 +48,13 @@ postScheduleR = do
-- $logInfoS "SCHEDULE-VIEW" $ "encountered error(s): " <> tshow errs
-- (return . FormFailure . mconcat . catMaybes . (fmap $ preview _FormFailure) . toNullable) errs
| otherwise -> case catMaybes $ catMaybes (formResultToMaybe <$> viewRess) of
--[sView] -> return $ FormSuccess $ scheduleView sView
[ScheduleOptions{scheduleView=sView}] -> return $ FormSuccess $ ScheduleOptions
{ scheduleView = sView
, scheduleOffset = ScheduleOffsetNone
, scheduleOptionsAction = ScheduleSetView
}
--_ -> return $ FormSuccess currentScheduleView
_ -> return $ FormSuccess $ ScheduleOptions
{ scheduleView = currentScheduleView
, scheduleOffset = ScheduleOffsetNone
_ -> return $ FormSuccess $ currentScheduleOptions
{ scheduleOffset = ScheduleOffsetNone
, scheduleOptionsAction = ScheduleSetView
}
@ -73,18 +65,17 @@ postScheduleR = do
, ScheduleOffsetNone
, ScheduleOffsetDays 1
, ScheduleOffsetDays 7
] <&> (\sNewOffset -> ScheduleOptions
{ scheduleView = currentScheduleView
, scheduleOffset = case sNewOffset of
] <&> (\sNewOffset -> currentScheduleOptions
{ scheduleOffset = case sNewOffset of
ScheduleOffsetNone -> ScheduleOffsetNone
_ -> currentScheduleOffset `addOffset` sNewOffset
_ -> (scheduleOffset currentScheduleOptions) `addOffset` sNewOffset
, scheduleOptionsAction = ScheduleSetOffset (offsetInDays sNewOffset)
})
_ -> mempty
(offsetRess, offsetWidgets) <- fmap unzip . for offsetBtns $ \btn ->
mopt (buttonField btn) ("" { fsName = Just $ toPathPiece GetScheduleOptions
, fsAttrs = if offsetInDays (scheduleOffset btn) == offsetInDays currentScheduleOffset then [("disabled","")] else mempty
, fsAttrs = if offsetInDays (scheduleOffset btn) == offsetInDays (scheduleOffset currentScheduleOptions) then [("disabled","")] else mempty
}) Nothing
offsetRes <- if
-- TODO: ignoring FormFailures for now
@ -93,17 +84,11 @@ postScheduleR = do
-- $logInfoS "SCHEDULE-OFFSET" $ "encountered error(s): " <> tshow errs
-- (return . FormFailure . mconcat . catMaybes . (fmap $ preview _FormFailure) . toNullable) errs
| otherwise -> case catMaybes $ catMaybes (formResultToMaybe <$> offsetRess) of
--[offset] -> (return . FormSuccess . scheduleOffset) offset
[opt] -> return $ FormSuccess opt
_ -> return $ FormSuccess $ ScheduleOptions
{ scheduleView = currentScheduleView
, scheduleOffset = currentScheduleOffset
, scheduleOptionsAction = currentScheduleOptionsAction
}
--_ -> return $ FormSuccess currentScheduleOffset
_ -> return $ FormSuccess currentScheduleOptions
let
-- scheduleResult = ScheduleOptions <$> viewRes <*> offsetRes <*> offsetActionRes
-- TODO: work in progress
scheduleResult = case (viewRes, offsetRes) of
(_, opts@(FormSuccess _)) -> opts
(opts@(FormSuccess _), _) -> opts