refactor(schedule): cleanup debug stuff

This commit is contained in:
Sarah Vaupel 2020-10-23 11:22:03 +02:00
parent c996049b3f
commit be442c6058

View File

@ -18,15 +18,6 @@ postScheduleR = do
-- TODO: local instead of global get params?
mOptions <- lookupGlobalGetParam GetScheduleOptions
-- TODO: remove (for PathPiece instance debugging only)
let debugScheduleOptions = ScheduleOptions
{ scheduleView = ScheduleViewWeek
, scheduleOffset = ScheduleOffsetDays 5
}
$logInfoS "TEST" $ "debugScheduleOptions: " <> toPathPiece debugScheduleOptions
$logInfoS "SCHEDULE" $ "encountered param: " <> tshow mOptions <> ", param path piece: " <> toPathPiece GetScheduleOptions
let
-- TODO: persist default schedule view in user settings, lookup default and choose schedule accordingly
-- if mView == Nothing
@ -42,18 +33,13 @@ postScheduleR = do
currentScheduleOffset :: ScheduleOffset
currentScheduleOffset = scheduleOffset $ fromMaybe defaultScheduleOptions mOptions
-- TODO: remove
--offsetFromWeekBtn :: ButtonScheduleOffsetWeek -> ScheduleOffset
--offsetFromWeekBtn btn = case schedBtnOffset btn of
-- ScheduleOffsetNone -> ScheduleOffsetNone
-- offset -> currentScheduleOffset `addOffset` offset
scheduleOptionsForm :: Html -> MForm (HandlerFor UniWorX) (FormResult ScheduleOptions, Widget)
scheduleOptionsForm csrf = do
(viewRess, viewWidgets) <- fmap unzip . for (universeF :: [ScheduleView]) $ \scheduleView ->
mopt (buttonField ScheduleOptions{scheduleOffset=ScheduleOffsetNone,..}) ("" { fsName = Just $ toPathPiece GetScheduleOptions
, fsAttrs = if scheduleView == currentScheduleView then [("disabled","")] else mempty
}) Nothing
mopt (buttonField ScheduleOptions{scheduleOffset=ScheduleOffsetNone,..})
("" { fsName = Just $ toPathPiece GetScheduleOptions
, fsAttrs = if scheduleView == currentScheduleView then [("disabled","")] else mempty
}) Nothing
viewRes <- if
-- TODO: ignoring FormFailures for now
-- | Just errs <- fromNullable (filter (is _FormFailure) viewRess) -> do
@ -61,13 +47,8 @@ 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] -> do
$logInfoS "SCHEDULE-VIEW" $ "encountered single view result: " <> tshow sView <> ", all results: " <> tshow viewRess
return $ FormSuccess $ scheduleView sView
_ -> do
$logInfoS "SCHEDULE-VIEW" $ "encountered no view, all results: " <> tshow viewRess
$logInfoS "SCHEDULE-VIEW" $ "currentScheduleView: " <> tshow currentScheduleView
return $ FormSuccess currentScheduleView
[sView] -> return $ FormSuccess $ scheduleView sView
_ -> return $ FormSuccess currentScheduleView
let
offsetBtns = case viewRes of
@ -96,14 +77,8 @@ 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] -> do
$logInfoS "SCHEDULE-OFFSET" $ "encountered single offset result: " <> tshow offset <> ", all results: " <> tshow offsetRess
$logInfoS "SCHEDULE-OFFSET" $ "currentScheduleOffset: " <> tshow currentScheduleOffset
(return . FormSuccess . scheduleOffset) offset
_ -> do
$logInfoS "SCHEDULE-OFFSET" $ "encountered no offset result, all results: " <> tshow offsetRess
$logInfoS "SCHEDULE-OFFSET" $ "currentScheduleOffset: " <> tshow currentScheduleOffset
return $ FormSuccess currentScheduleOffset
[offset] -> (return . FormSuccess . scheduleOffset) offset
_ -> return $ FormSuccess currentScheduleOffset
let
scheduleResult = ScheduleOptions <$> viewRes <*> offsetRes