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

fix: improve exam occurrence ui

Browse Source
This commit is contained in:
Gregor Kleen 2020-01-11 23:44:47 +01:00
parent 14bb020fe9
commit 83fa9c9c69
11 changed files with 33 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
messages/uniworx/de-de-formal.msg
View File

@ -1541,8 +1541,8 @@ ExamBonusRound: Bonus runden auf
ExamBonusRoundNonPositive: Vielfaches, auf das gerundet werden soll, muss positiv und größer null sein
ExamBonusRoundTip: Bonuspunkte werden kaufmännisch auf ein Vielfaches der angegeben Zahl gerundet.
ExamAutomaticOccurrenceAssignment: Automatische oder selbständige Termin- bzw. Raumzuteilung
ExamAutomaticOccurrenceAssignmentTip: Sollen Prüfungsteilnehmer automatisch auf die zur Verfügung stehenden Räume bzw. Termine verteilt werden oder sich selbstständig einen Raum bzw. Termin aussuchen dürfen? Manuelle Umverteilung bzw. vorheriges Festlegen von Zuteilungen einzelner Teilnehmer ist trotzdem möglich.
ExamAutomaticOccurrenceAssignment: Termin- bzw. Raumzuteilung
ExamAutomaticOccurrenceAssignmentTip: Sollen Prüfungsteilnehmer automatisch auf die zur Verfügung stehenden Räume bzw. Termine verteilt werden, sich selbstständig einen Raum bzw. Termin aussuchen dürfen oder manuell durch Kursverwalter zugeteilt werden? Manuelle Umverteilung bzw. vorheriges Festlegen von Zuteilungen einzelner Teilnehmer ist trotzdem möglich.
ExamOccurrenceRule: Verfahren
ExamOccurrenceRuleParticipant: Termin- bzw. Raumzuteilungsverfahren
ExamRoomManual': Keine automatische bzw. selbstständige Zuteilung

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

@ -1540,7 +1540,7 @@ ExamBonusRoundNonPositive: Rounding multiple must be positive and greater than z
ExamBonusRoundTip: Bonus points are rounded commercially to a multiple of the given number
ExamAutomaticOccurrenceAssignment: Selection of occurrences/rooms for/by participants
ExamAutomaticOccurrenceAssignmentTip: Should exam participants be distributed automatically among the configured occurrences/rooms? Should they instead be permitted to autonomously choose an occurrence/a room? Manipulation of the distribution and manually assigning participants remains possible.
ExamAutomaticOccurrenceAssignmentTip: Should exam participants be distributed automatically among the configured occurrences/rooms, should they instead be permitted to autonomously choose an occurrence/a room, or should they be assigned to occurrences/rooms manually by course administrators? Manipulation of the distribution and manually assigning participants remains possible.
ExamOccurrenceRule: Procedure
ExamOccurrenceRuleParticipant: Occurrence/room assignment procedure
ExamRoomManual': No automatic or autonomous assignment

2
models/exams.model
View File

@ -3,7 +3,7 @@ Exam
name ExamName
gradingRule ExamGradingRule Maybe
bonusRule ExamBonusRule Maybe
occurrenceRule ExamOccurrenceRule Maybe
occurrenceRule ExamOccurrenceRule
visibleFrom UTCTime Maybe
registerFrom UTCTime Maybe
registerTo UTCTime Maybe

2
src/Foundation.hs
View File

@ -778,7 +778,7 @@ tagAccessPredicate AuthExamOccurrenceRegistration = APDB $ \_ route _ -> case ro
E.&&. course E.^. CourseSchool E.==. E.val ssh
E.&&. course E.^. CourseShorthand E.==. E.val csh
E.&&. exam E.^. ExamName E.==. E.val examn
E.&&. exam E.^. ExamOccurrenceRule E.==. E.val (Just ExamRoomFifo)
E.&&. exam E.^. ExamOccurrenceRule E.==. E.val ExamRoomFifo
guardMExceptT isOccurrenceRegistration (unauthorizedI MsgUnauthorizedExamOccurrenceRegistration)
return Authorized
r -> $unsupportedAuthPredicate AuthExamOccurrenceRegistration r

4
src/Handler/Exam/Form.hs
View File

@ -39,7 +39,7 @@ data ExamForm = ExamForm
, efPublicStatistics :: Bool
, efGradingRule :: Maybe ExamGradingRule
, efBonusRule :: Maybe ExamBonusRule
, efOccurrenceRule :: Maybe ExamOccurrenceRule
, efOccurrenceRule :: ExamOccurrenceRule
, efCorrectors :: Set (Either UserEmail UserId)
, efExamParts :: Set ExamPartForm
}
@ -96,7 +96,7 @@ examForm template html = do
<*> apopt checkBoxField (fslI MsgExamPublicStatistics & setTooltip MsgExamPublicStatisticsTip) (efPublicStatistics <$> template <|> Just True)
<*> optionalActionA (examGradingRuleForm $ efGradingRule =<< template) (fslI MsgExamAutomaticGrading & setTooltip MsgExamAutomaticGradingTip) (is _Just . efGradingRule <$> template)
<*> optionalActionA (examBonusRuleForm $ efBonusRule =<< template) (fslI MsgExamBonus) (is _Just . efBonusRule <$> template)
<*> optionalActionA (examOccurrenceRuleForm $ efOccurrenceRule =<< template) (fslI MsgExamAutomaticOccurrenceAssignment & setTooltip MsgExamAutomaticOccurrenceAssignmentTip) (is _Just . efOccurrenceRule <$> template)
<*> (examOccurrenceRuleForm $ efOccurrenceRule <$> template)
<* aformSection MsgExamFormCorrection
<*> examCorrectorsForm (efCorrectors <$> template)
<* aformSection MsgExamFormParts

10
src/Handler/Exam/Show.hs
View File

@ -30,7 +30,7 @@ getEShowR tid ssh csh examn = do
let gradingVisible = NTop (Just cTime) >= NTop examFinished
gradingShown <- or2M (return gradingVisible) . hasReadAccessTo $ CExamR tid ssh csh examn EEditR
let occurrenceAssignmentsVisible = NTop (Just cTime) >= NTop examPublishOccurrenceAssignments || examOccurrenceRule == Just ExamRoomFifo
let occurrenceAssignmentsVisible = NTop (Just cTime) >= NTop examPublishOccurrenceAssignments || examOccurrenceRule == ExamRoomFifo
occurrenceAssignmentsShown <- or2M (return occurrenceAssignmentsVisible) . hasReadAccessTo $ CExamR tid ssh csh examn EEditR
examParts <- sortOn (view $ _entityVal . _examPartNumber) <$> selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ]
@ -60,7 +60,7 @@ getEShowR tid ssh csh examn = do
registered <- for mUid $ getBy . UniqueExamRegistration eId
mayRegister <- if
| examOccurrenceRule == Just ExamRoomFifo -> anyM occurrencesRaw $ \(Entity _ ExamOccurrence{..}, _) ->
| examOccurrenceRule == ExamRoomFifo -> anyM occurrencesRaw $ \(Entity _ ExamOccurrence{..}, _) ->
hasWriteAccessTo . CExamR tid ssh csh examName $ ERegisterOccR examOccurrenceName
| otherwise -> hasWriteAccessTo $ CExamR tid ssh csh examName ERegisterR
@ -99,7 +99,7 @@ getEShowR tid ssh csh examn = do
let examTimes = all (\(Entity _ ExamOccurrence{..}, _) -> Just examOccurrenceStart == examStart && examOccurrenceEnd == examEnd) occurrences
registerWidget mOcc
| isRegistered <- is _Just $ join registered
, examOccurrenceRule /= Just ExamRoomFifo || (isRegistered && not (any snd occurrences))
, examOccurrenceRule /= ExamRoomFifo || (isRegistered && not (any snd occurrences))
, mayRegister' (entityKey <$> mOcc) = Just $ do
(examRegisterForm, examRegisterEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [BtnExamRegister] [BtnExamDeregister] isRegistered
[whamlet|
@ -114,7 +114,7 @@ getEShowR tid ssh csh examn = do
, formEncoding = examRegisterEnctype
, formSubmit = FormNoSubmit
}
| examOccurrenceRule == Just ExamRoomFifo
| examOccurrenceRule == ExamRoomFifo
, Just (Entity occId ExamOccurrence{..}) <- mOcc
, isRegistered <- (== Just occId) $ examRegistrationOccurrence . entityVal =<< join registered
, mayRegister' (Just occId) = Just $ do
@ -143,7 +143,7 @@ getEShowR tid ssh csh examn = do
showMaxPoints = any (has $ _entityVal . _examPartMaxPoints . _Just) examParts
showAchievedPoints = not $ null results
showOccurrenceRegisterColumn = occurrenceAssignmentsShown || (mayRegister && examOccurrenceRule == Just ExamRoomFifo)
showOccurrenceRegisterColumn = occurrenceAssignmentsShown || (mayRegister && examOccurrenceRule == ExamRoomFifo)
markUnregisteredOccurrences mOcc = occurrenceAssignmentsShown && hasRegistration && isn't _Just (registerWidget mOcc)
let heading = prependCourseTitle tid ssh csh $ CI.original examName

11
src/Handler/Utils/Form.hs
View File

@ -554,10 +554,11 @@ examBonusRuleForm prev = multiActionA actions (fslI MsgExamBonusRule) $ classify
)
]
data ExamOccurrenceRule' = ExamRoomSurname'
data ExamOccurrenceRule' = ExamRoomManual'
| ExamRoomFifo'
| ExamRoomSurname'
| ExamRoomMatriculation'
| ExamRoomRandom'
| ExamRoomFifo'
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
instance Universe ExamOccurrenceRule'
instance Finite ExamOccurrenceRule'
@ -567,19 +568,21 @@ embedRenderMessage ''UniWorX ''ExamOccurrenceRule' id
classifyExamOccurrenceRule :: ExamOccurrenceRule -> ExamOccurrenceRule'
classifyExamOccurrenceRule = \case
ExamRoomManual -> ExamRoomManual'
ExamRoomSurname -> ExamRoomSurname'
ExamRoomMatriculation -> ExamRoomMatriculation'
ExamRoomRandom -> ExamRoomRandom'
ExamRoomFifo -> ExamRoomFifo'
examOccurrenceRuleForm :: Maybe ExamOccurrenceRule -> AForm Handler ExamOccurrenceRule
examOccurrenceRuleForm = fmap reverseClassify . areq (selectField optionsFinite) (fslI MsgExamOccurrenceRule) . fmap classifyExamOccurrenceRule
examOccurrenceRuleForm = fmap reverseClassify . areq (selectField optionsFinite) (fslI MsgExamAutomaticOccurrenceAssignment & setTooltip MsgExamAutomaticOccurrenceAssignmentTip) . fmap classifyExamOccurrenceRule
where
reverseClassify = \case
ExamRoomManual' -> ExamRoomManual
ExamRoomFifo' -> ExamRoomFifo
ExamRoomSurname' -> ExamRoomSurname
ExamRoomMatriculation' -> ExamRoomMatriculation
ExamRoomRandom' -> ExamRoomRandom
ExamRoomFifo' -> ExamRoomFifo
data ExamGradingRule' = ExamGradingKey'
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)

7
src/Model/Migration.hs
View File

@ -599,6 +599,13 @@ customMigrations = Map.fromListWith (>>)
ALTER TABLE "study_features" DROP COLUMN "sub_field";
|]
)
, ( AppliedMigrationKey [migrationVersion|29.0.0|] [version|30.0.0|]
, whenM (tableExists "exam") $
[executeQQ|
UPDATE "exam" SET "occurrence_rule" = #{ExamRoomManual} WHERE "occurrence_rule" IS NULL;
ALTER TABLE "exam" ALTER COLUMN "occurrence_rule" SET NOT NULL;
|]
)
]

5
src/Model/Types/Exam.hs
View File

@ -136,10 +136,11 @@ deriveJSON defaultOptions
} ''ExamBonusRule
derivePersistFieldJSON ''ExamBonusRule
data ExamOccurrenceRule = ExamRoomSurname
data ExamOccurrenceRule = ExamRoomManual
| ExamRoomFifo
| ExamRoomSurname
| ExamRoomMatriculation
| ExamRoomRandom
| ExamRoomFifo
deriving (Show, Read, Eq, Ord, Generic, Typeable)
deriveJSON defaultOptions
{ fieldLabelModifier = camelToPathPiece' 1

6
templates/exam-show.hamlet
View File

@ -76,14 +76,14 @@ $maybe desc <- examDescription
\ ^{isVisible False}
<dd .deflist__dd>
^{examBonusW bonusRule}
$maybe occurrenceRule <- examOccurrenceRule
$if examOccurrenceRule /= ExamRoomManual
$if occurrenceAssignmentsShown
<dt .deflist__dt>
_{MsgExamOccurrenceRuleParticipant}
$if not occurrenceAssignmentsVisible
\ ^{isVisible False}
<dd .deflist__dd>
_{classifyExamOccurrenceRule occurrenceRule}
_{classifyExamOccurrenceRule examOccurrenceRule}
$maybe registerWdgt <- registerWidget Nothing
<dt .deflist__dt>_{MsgExamRegistration}
<dd .deflist__dd>^{registerWdgt}
@ -108,7 +108,7 @@ $if not (null occurrences)
<th .table__th>_{MsgExamRoomTime}
$if showOccurrenceRegisterColumn
<th .table__th>
$if examOccurrenceRule == Just ExamRoomFifo
$if examOccurrenceRule == ExamRoomFifo
_{MsgExamRoomRegistered}
$else
_{MsgExamRoomAssigned}

2
test/Database.hs
View File

@ -504,7 +504,7 @@ fillDb = do
, examName = "Klausur"
, examGradingRule = Nothing
, examBonusRule = Nothing
, examOccurrenceRule = Nothing
, examOccurrenceRule = ExamRoomManual
, examVisibleFrom = Just now
, examRegisterFrom = Just now
, examRegisterTo = Just $ addUTCTime (14 * nominalDay) now