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