fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

chore: create (incomplete) ignore/reconsider buttons

Browse Source
This commit is contained in:
Wolfgang Witt 2021-03-17 16:42:16 +01:00 committed by Gregor Kleen
parent 25262aa7a5
commit a35a481f33
6 changed files with 53 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
messages/uniworx/misc/de-de-formal.msg
View File

@ -2824,6 +2824,8 @@ BtnExamAutoOccurrenceCalculate: Verteilungstabelle berechnen
BtnExamAutoOccurrenceAccept: Verteilung akzeptieren
BtnExamAutoOccurrenceNudgeUp: +
BtnExamAutoOccurrenceNudgeDown: -
BtnExamAutoOccurrenceIgnoreEnable: Ignorieren
BtnExamAutoOccurrenceIgnoreDisable: Berücksichtigen
ExamRoomMappingSurname: Nachnamen beginnend mit
ExamRoomMappingMatriculation: Matrikelnummern endend in
ExamRoomMappingRandom: Verteilung

2
messages/uniworx/misc/en-eu.msg
View File

@ -2824,6 +2824,8 @@ BtnExamAutoOccurrenceCalculate: Calculate assignment rules
BtnExamAutoOccurrenceAccept: Accept assignments
BtnExamAutoOccurrenceNudgeUp: +
BtnExamAutoOccurrenceNudgeDown: -
BtnExamAutoOccurrenceIgnoreEnable: Ignore
BtnExamAutoOccurrenceIgnoreDisable: Reconsider
ExamRoomMappingSurname: Surnames starting with
ExamRoomMappingMatriculation: Matriculation numbers ending in
ExamRoomMappingRandom: Distribution

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

@ -10,6 +10,7 @@ import Handler.Utils
import Handler.Utils.Exam
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Database.Esqueleto as E
import Database.Persist.Sql (updateWhereCount)
@ -35,6 +36,7 @@ data ExamAutoOccurrenceButton
= BtnExamAutoOccurrenceCalculate
| BtnExamAutoOccurrenceAccept
| BtnExamAutoOccurrenceNudgeUp | BtnExamAutoOccurrenceNudgeDown
| BtnExamAutoOccurrenceIgnoreEnable | BtnExamAutoOccurrenceIgnoreDisable
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
instance Universe ExamAutoOccurrenceButton
instance Finite ExamAutoOccurrenceButton
@ -53,8 +55,14 @@ examAutoOccurrenceCalculateForm ExamAutoOccurrenceCalculateForm{ eaofConfig }
= identifyForm FIDExamAutoOccurrenceCalculate . renderAForm FormStandard $ ExamAutoOccurrenceCalculateForm <$> eaocForm
where
eaocForm =
(set _eaocMinimizeRooms <$> apopt checkBoxField (fslI MsgExamAutoOccurrenceMinimizeRooms & setTooltip MsgExamAutoOccurrenceMinimizeRoomsTip) (Just $ eaofConfig ^. _eaocMinimizeRooms))
(set _eaocIgnoreRooms . automaticIfTrue <$> apopt checkBoxField (fslI MsgExamAutoOccurrenceMinimizeRooms & setTooltip MsgExamAutoOccurrenceMinimizeRoomsTip) (Just . ignoreRooms $ eaofConfig ^. _eaocIgnoreRooms))
<*> pure def
automaticIfTrue :: Bool -> ExamAutoOccurrenceIgnoreRooms
automaticIfTrue True = EAOIRAutomatic
automaticIfTrue False = EAOIRManual Set.empty
ignoreRooms :: ExamAutoOccurrenceIgnoreRooms -> Bool
ignoreRooms EAOIRAutomatic = True
ignoreRooms (EAOIRManual s) = null s
examAutoOccurrenceNudgeForm :: ExamOccurrenceId -> Maybe ExamAutoOccurrenceCalculateForm -> Form ExamAutoOccurrenceCalculateForm
examAutoOccurrenceNudgeForm occId protoForm html = do
@ -73,6 +81,28 @@ 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
cID <- encrypt occId
-- TODO new constructor instead of FIDExamAutoOccurrenceNudge
-- type FormIdentifier, lives in Utils.Form
(btnRes, wgt) <- identifyForm (FIDExamAutoOccurrenceIgnoreRooms $ ciphertext cID) (buttonForm' [BtnExamAutoOccurrenceIgnoreEnable, BtnExamAutoOccurrenceIgnoreDisable]) html
oldDataRes <- globalPostParamField PostExamAutoOccurrencePrevious secretJsonField
oldDataId <- newIdent
let protoForm' = fromMaybe def $ oldDataRes <|> protoForm
genForm btn = protoForm' & _eaofConfig . _eaocIgnoreRooms %~ EAOIRManual . action occId . toManualSet
where
toManualSet EAOIRAutomatic = Set.empty
toManualSet (EAOIRManual s) = s
action = case btn of
BtnExamAutoOccurrenceIgnoreEnable -> Set.insert
BtnExamAutoOccurrenceIgnoreDisable -> Set.delete
_other -> flip const -- i.e. ignore argument
res = genForm <$> btnRes
oldDataView = fieldView (secretJsonField :: Field Handler _) oldDataId (toPathPiece PostExamAutoOccurrencePrevious) [] (Right . fromMaybe protoForm' $ formResult' res) False
return (res, wgt <> oldDataView)
examAutoOccurrenceAcceptForm :: Maybe ExamAutoOccurrenceAcceptForm -> Form ExamAutoOccurrenceAcceptForm
examAutoOccurrenceAcceptForm confirmData = identifyForm FIDExamAutoOccurrenceConfirm $ \html -> do
(confirmDataRes, confirmDataView) <- mreq secretJsonField "" confirmData
@ -102,8 +132,11 @@ postEAutoOccurrenceR tid ssh csh examn = do
nudgeRes <- sequence . flip Map.fromSet (setOf (folded . _entityKey) occurrences) $ \occId ->
runFormPost $ examAutoOccurrenceNudgeForm occId (formResult' calculateRes)
ignoreRoomsRes <- sequence . flip Map.fromSet (setOf (folded . _entityKey) occurrences) $ \occId ->
runFormPost $ examAutoOccurrenceIgnoreRoomsForm occId (formResult' calculateRes)
let calculateRes' = asum $ calculateRes : nudgeRes ^.. folded . _1 . _1
let calculateRes' = asum $ calculateRes : nudgeRes ^.. folded . _1 . _1 ++ ignoreRoomsRes ^.. folded . _1 . _1
calcResult <- formResultMaybe calculateRes' $ \ExamAutoOccurrenceCalculateForm{..} -> runDB $ do
participants <- E.select . E.from $ \(registration `E.InnerJoin` user) -> do
@ -115,11 +148,12 @@ postEAutoOccurrenceR tid ssh csh examn = do
return (uid, (userRec, examRegistrationOccurrence))
occurrences' = Map.fromList $ map (\(Entity eoId ExamOccurrence{..}) -> (eoId, _examOccurrenceCapacityIso # (fromIntegral <$> examOccurrenceCapacity))) occurrences
autoOccurrenceResult = examAutoOccurrence eId examOccurrenceRule eaofConfig occurrences' participants'
(eaofMapping, eaofAssignment) <- case autoOccurrenceResult of
(eaofMapping, eaofAssignment, _ignoredOccurrences) <- case autoOccurrenceResult of
(Left e) -> do
addMessageI Error e
redirect $ CExamR tid ssh csh examn EUsersR
(Right r) -> pure r
-- TODO use returned ignoredOccurrences
return $ Just ExamAutoOccurrenceAcceptForm{..}
((confirmRes, confirmView), confirmEncoding) <- runFormPost $ examAutoOccurrenceAcceptForm calcResult
@ -153,6 +187,14 @@ postEAutoOccurrenceR tid ssh csh examn = do
, formAttrs = [("class", "buttongroup")]
}
let ignoreRoomWgt = ignoreRoomsRes <&> \((_, ignoreRoomsView), ignoreRoomsEncoding) ->
wrapForm ignoreRoomsView def
{ formAction = Just . SomeRoute $ CExamR tid ssh csh examn EAutoOccurrenceR
, formEncoding = ignoreRoomsEncoding
, formSubmit = FormNoSubmit
, formAttrs = [("class", "buttongroup")]
}
ExamAutoOccurrenceAcceptForm{..} <- maybe (redirect $ CExamR tid ssh csh examn EUsersR) return calcResult
let heading = MsgTitleExamAutoOccurrence tid ssh csh examn

2
src/Handler/Utils/Exam.hs
View File

@ -6,7 +6,7 @@ module Handler.Utils.Exam
, examRelevantSheets, examBonusPossible, examBonusAchieved
, examResultBonus, examGrade
, examBonusGrade
, ExamAutoOccurrenceConfig
, ExamAutoOccurrenceConfig, ExamAutoOccurrenceIgnoreRooms(..)
, eaocIgnoreRooms, eaocFinenessCost, eaocNudge, eaocNudgeSize
, _eaocIgnoreRooms, _eaocFinenessCost, _eaocNudge, _eaocNudgeSize
, ExamAutoOccurrenceException(..)

2
src/Utils/Form.hs
View File

@ -229,7 +229,7 @@ data FormIdentifier
| FIDUserAuthMode | FIDUserAssimilate | FIDUserRights | FIDUserAuthentication
| FIDAllUsersAction
| FIDLanguage
| FIDExamAutoOccurrenceCalculate | FIDExamAutoOccurrenceConfirm | FIDExamAutoOccurrenceNudge UUID
| FIDExamAutoOccurrenceCalculate | FIDExamAutoOccurrenceConfirm | FIDExamAutoOccurrenceNudge UUID | FIDExamAutoOccurrenceIgnoreRooms UUID
| FIDAllocationAccept
| FIDTestDownload
| FIDAllocationRegister

2
templates/widgets/exam-occurrence-mapping.hamlet
View File

@ -34,6 +34,8 @@ $newline never
<td .table__td>
$maybe nudgeWgt' <- Map.lookup occId nudgeWgt
^{nudgeWgt'}
$maybe ignoreRoomWgt' <- Map.lookup occId ignoreRoomWgt
^{ignoreRoomWgt'}
<td .table__td>
$maybe mappingWgt <- occMapping occId
^{mappingWgt}