fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore: always show the correct ignore/reconsider button

Browse Source
This commit is contained in:
Wolfgang Witt 2021-03-19 13:25:38 +01:00 committed by Gregor Kleen
parent b2d6eada17
commit a36f0deb09
1 changed files with 25 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
src/Handler/Exam/AutoOccurrence.hs
View File

@ -107,20 +107,33 @@ examAutoOccurrenceNudgeForm occId protoForm html = do
oldDataView = fieldView (secretJsonField :: Field Handler _) oldDataId (toPathPiece PostExamAutoOccurrencePrevious) [] (Right . fromMaybe protoForm' $ formResult' res) False
return (res, wgt <> oldDataView)
examAutoOccurrenceIgnoreRoomsForm :: ExamOccurrenceId -> Maybe ExamAutoOccurrenceCalculateForm -> Form ExamAutoOccurrenceCalculateForm
examAutoOccurrenceIgnoreRoomsForm occId protoForm html = do
examAutoOccurrenceIgnoreRoomsForm :: ExamOccurrenceId
-> Maybe ExamAutoOccurrenceCalculateForm
-> Maybe ExamAutoOccurrenceCalculateForm
-> Form ExamAutoOccurrenceCalculateForm
examAutoOccurrenceIgnoreRoomsForm occId calculateRes protoForm html = do
cID <- encrypt occId
oldDataRes <- globalPostParamField PostExamAutoOccurrencePrevious secretJsonField
oldDataId <- newIdent
let shownButtons = case eaocIgnoreRooms . eaofConfig $ fromMaybe def oldDataRes of
ExamAutoOccurrenceIgnoreRooms {eaoirIgnored}
| Set.member occId eaoirIgnored
-> [BtnExamAutoOccurrenceReconsider]
| otherwise
-> [BtnExamAutoOccurrenceIgnore]
(btnRes, wgt) <- identifyForm (FIDExamAutoOccurrenceIgnoreRoom $ ciphertext cID) (buttonForm' shownButtons) html
let protoForm' = fromMaybe def $ protoForm <|> oldDataRes
-- create both buttons
(btnResIgnore, wgtIgnore) <- identifyForm (FIDExamAutoOccurrenceIgnoreRoom $ ciphertext cID) (buttonForm' [BtnExamAutoOccurrenceIgnore]) html
(btnResReconsider, wgtReconsider) <- identifyForm (FIDExamAutoOccurrenceIgnoreRoom $ ciphertext cID) (buttonForm' [BtnExamAutoOccurrenceReconsider]) html
-- choose the relevant button to display
let btnRes = btnResIgnore <|> btnResReconsider
wgt = case btnRes of
(FormSuccess BtnExamAutoOccurrenceIgnore) -> wgtReconsider
(FormSuccess BtnExamAutoOccurrenceReconsider) -> wgtIgnore
_otherwise -> case eaocIgnoreRooms . eaofConfig $ fromMaybe def $ calculateRes <|> oldDataRes of
ExamAutoOccurrenceIgnoreRooms {eaoirIgnored}
| Set.member occId eaoirIgnored
-> wgtReconsider
| otherwise
-> wgtIgnore
let protoForm' = fromMaybe def $ calculateRes <|> protoForm <|> oldDataRes
genForm btn = protoForm' & _eaofConfig . _eaocIgnoreRooms . _eaoirIgnored %~ action occId
where
action = case btn of
@ -166,16 +179,12 @@ postEAutoOccurrenceR tid ssh csh examn = do
occurrences' = Map.fromList $ map (\(Entity eoId ExamOccurrence{..}) -> (eoId, _examOccurrenceCapacityIso # (fromIntegral <$> examOccurrenceCapacity))) occurrences
((calculateRes, _), _) <- runFormPost $ examAutoOccurrenceCalculateForm occurrences' participants' def
liftIO $ do
putStrLn "-------------------"
print calculateRes
putStrLn "-------------------"
(nudgeRes, ignoreRes) <- mdo
nudgeRes <- sequence . flip Map.fromSet (setOf (folded . _entityKey) occurrences) $ \occId ->
runFormPost $ examAutoOccurrenceNudgeForm occId (formResult' . asum $ calculateRes : nudgeRes ^.. ifolded . ifiltered (\occId' _ -> occId' /= occId) . _1 . _1 ++ ignoreRes ^.. folded . _1 . _1)
runFormPost $ examAutoOccurrenceNudgeForm occId (formResult' . asum $ nudgeRes ^.. ifolded . ifiltered (\occId' _ -> occId' /= occId) . _1 . _1 ++ ignoreRes ^.. folded . _1 . _1)
ignoreRes <- sequence . flip Map.fromSet (setOf (folded . _entityKey) occurrences) $ \occId ->
runFormPost $ examAutoOccurrenceIgnoreRoomsForm occId (formResult' . asum $ calculateRes : nudgeRes ^.. folded . _1 . _1 ++ ignoreRes ^.. ifolded . ifiltered (\occId' _ -> occId' /= occId) . _1 . _1)
runFormPost $ examAutoOccurrenceIgnoreRoomsForm occId (formResult' calculateRes) (formResult' . asum $ nudgeRes ^.. folded . _1 . _1 ++ ignoreRes ^.. ifolded . ifiltered (\occId' _ -> occId' /= occId) . _1 . _1)
return (nudgeRes, ignoreRes)