diff --git a/src/Handler/Schedule.hs b/src/Handler/Schedule.hs index fa9d85eb0..a16053dac 100644 --- a/src/Handler/Schedule.hs +++ b/src/Handler/Schedule.hs @@ -42,22 +42,40 @@ postScheduleR = do scheduleOptionsForm :: MForm (HandlerFor UniWorX) (FormResult ScheduleOptions, Widget) scheduleOptionsForm = do - -- viewRess :: [FormResult (Maybe ScheduleView)] - (_viewRess, viewWidgets) <- fmap unzip . for (universeF :: [ScheduleView]) $ \sView -> + (viewRess, viewWidgets) <- fmap unzip . for (universeF :: [ScheduleView]) $ \sView -> mopt (buttonField sView) ("" { fsName = Just $ toPathPiece GetScheduleView , fsAttrs = if sView == currentScheduleView then [("disabled","")] else mempty }) Nothing - -- TODO: choose offset button set according to viewRess - let - -- offsetRess :: [FormResult (Maybe ScheduleOffset)] - (_offsetRess, offsetWidgets) <- fmap unzip . for (universeF :: [ButtonScheduleOffsetWeek]) $ \sOffsetBtn -> - mopt (buttonField sOffsetBtn) ("" { fsName = Just $ toPathPiece GetScheduleOffset - , fsAttrs = if offsetFromWeekBtn sOffsetBtn == currentScheduleOffset then [("disabled","")] else mempty - }) Nothing + viewRes <- if + | errs@(_:_) <- filter (is _FormFailure) viewRess -> do + mapM_ formFailure2Alerts errs + return $ FormMissing -- TODO: return FormFailure + | all (== FormMissing) viewRess -> return $ FormSuccess currentScheduleView -- TODO: rethink + | otherwise -> case catMaybes (formResultToMaybe <$> viewRess) of -- TODO: rethink this case + [Just sView] -> return $ FormSuccess sView + _ -> return $ FormSuccess currentScheduleView - -- TODO: use viewRess and offsetRess let - scheduleResult = ScheduleOptions <$> FormSuccess ScheduleViewWeek <*> FormSuccess ScheduleOffsetNone + offsetBtns = case viewRes of + FormSuccess ScheduleViewWeek -> (universeF :: [ButtonScheduleOffsetWeek]) + _ -> mempty + + (offsetRess, offsetWidgets) <- fmap unzip . for offsetBtns $ \btn -> + mopt (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 + | otherwise -> case catMaybes (formResultToMaybe <$> offsetRess) of -- TODO: rethink this case + [Just offset] -> return $ FormSuccess $ currentScheduleOffset `addOffsets` (schedBtnOffset offset) + _ -> return $ FormSuccess currentScheduleOffset + + let + scheduleResult = ScheduleOptions <$> viewRes <*> offsetRes optionsWidget = $(widgetFile "schedule/options") return (scheduleResult, optionsWidget)