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

fix: buttons know about ALL actions from other buttons

Browse Source
This commit is contained in:
Wolfgang Witt 2021-03-18 14:35:10 +01:00 committed by Gregor Kleen
parent 13af035223
commit 11664dcd82
1 changed files with 11 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -71,12 +71,9 @@ examAutoOccurrenceNudgeForm occId protoForm html = do
cID <- encrypt occId cID <- encrypt occId
(btnRes, wgt) <- identifyForm (FIDExamAutoOccurrenceNudge $ ciphertext cID) (buttonForm' [BtnExamAutoOccurrenceNudgeUp, BtnExamAutoOccurrenceNudgeDown]) html (btnRes, wgt) <- identifyForm (FIDExamAutoOccurrenceNudge $ ciphertext cID) (buttonForm' [BtnExamAutoOccurrenceNudgeUp, BtnExamAutoOccurrenceNudgeDown]) html
oldDataRes <- globalPostParamField PostExamAutoOccurrencePrevious secretJsonField oldDataRes <- globalPostParamField PostExamAutoOccurrencePrevious secretJsonField
liftIO $ do
putStrLn "\n\nnudge"
print $ eaocNudge . eaofConfig <$> oldDataRes
oldDataId <- newIdent oldDataId <- newIdent
let protoForm' = fromMaybe def $ oldDataRes <|> protoForm let protoForm' = fromMaybe def $ protoForm <|> oldDataRes
genForm btn = protoForm' & _eaofConfig . _eaocNudge %~ Map.insertWith (+) occId n genForm btn = protoForm' & _eaofConfig . _eaocNudge %~ Map.insertWith (+) occId n
where n = case btn of where n = case btn of
BtnExamAutoOccurrenceNudgeUp -> 1 BtnExamAutoOccurrenceNudgeUp -> 1
@ -93,7 +90,7 @@ examAutoOccurrenceIgnoreRoomsForm occId protoForm html = do
oldDataRes <- globalPostParamField PostExamAutoOccurrencePrevious secretJsonField oldDataRes <- globalPostParamField PostExamAutoOccurrencePrevious secretJsonField
oldDataId <- newIdent oldDataId <- newIdent
let protoForm' = fromMaybe def $ oldDataRes <|> protoForm let protoForm' = fromMaybe def $ protoForm <|> oldDataRes
genForm btn = protoForm' & _eaofConfig . _eaocIgnoreRooms %~ action genForm btn = protoForm' & _eaofConfig . _eaocIgnoreRooms %~ action
where where
action EAOIRAutomatic = EAOIRManual {eaoirmIgnored=Set.empty, eaoirmSorted=True} action EAOIRAutomatic = EAOIRManual {eaoirmIgnored=Set.empty, eaoirmSorted=True}
@ -132,13 +129,15 @@ postEAutoOccurrenceR tid ssh csh examn = do
((calculateRes, _), _) <- runFormPost $ examAutoOccurrenceCalculateForm def ((calculateRes, _), _) <- runFormPost $ examAutoOccurrenceCalculateForm def
nudgeRes <- sequence . flip Map.fromSet (setOf (folded . _entityKey) occurrences) $ \occId -> (nudgeRes, ignoreRes) <- mdo
runFormPost $ examAutoOccurrenceNudgeForm occId (formResult' calculateRes) 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)
ignoreRoomsRes <- sequence . flip Map.fromSet (setOf (folded . _entityKey) occurrences) $ \occId -> ignoreRes <- sequence . flip Map.fromSet (setOf (folded . _entityKey) occurrences) $ \occId ->
runFormPost $ examAutoOccurrenceIgnoreRoomsForm occId (formResult' calculateRes) runFormPost $ examAutoOccurrenceIgnoreRoomsForm occId (formResult' . asum $ calculateRes : nudgeRes ^.. folded . _1 . _1 ++ ignoreRes ^.. ifolded . ifiltered (\occId' _ -> occId' /= occId) . _1 . _1)
return $ (nudgeRes, ignoreRes)
let calculateRes' = asum $ calculateRes : nudgeRes ^.. folded . _1 . _1 ++ ignoreRoomsRes ^.. folded . _1 . _1
let calculateRes' = asum $ calculateRes : nudgeRes ^.. folded . _1 . _1 ++ ignoreRes ^.. folded . _1 . _1
calcResult <- formResultMaybe calculateRes' $ \ExamAutoOccurrenceCalculateForm{..} -> runDB $ do calcResult <- formResultMaybe calculateRes' $ \ExamAutoOccurrenceCalculateForm{..} -> runDB $ do
participants <- E.select . E.from $ \(registration `E.InnerJoin` user) -> do participants <- E.select . E.from $ \(registration `E.InnerJoin` user) -> do
@ -189,7 +188,7 @@ postEAutoOccurrenceR tid ssh csh examn = do
, formAttrs = [("class", "buttongroup")] , formAttrs = [("class", "buttongroup")]
} }
let ignoreRoomWgt = ignoreRoomsRes <&> \((_, ignoreRoomsView), ignoreRoomsEncoding) -> let ignoreRoomWgt = ignoreRes <&> \((_, ignoreRoomsView), ignoreRoomsEncoding) ->
wrapForm ignoreRoomsView def wrapForm ignoreRoomsView def
{ formAction = Just . SomeRoute $ CExamR tid ssh csh examn EAutoOccurrenceR { formAction = Just . SomeRoute $ CExamR tid ssh csh examn EAutoOccurrenceR
, formEncoding = ignoreRoomsEncoding , formEncoding = ignoreRoomsEncoding