feat(exams): show number of registrations to course admins
This commit is contained in:
Gregor Kleen
parent
b6ec54cfec
commit
ec020c5486
@ -2447,6 +2447,8 @@ BtnExamAutoOccurrenceNudgeDown: -
|
||||
ExamRoomMappingSurname: Nachnamen beginnend mit
|
||||
ExamRoomMappingMatriculation: Matrikelnummern endend in
|
||||
ExamRoomLoad: Auslastung
|
||||
ExamRegisteredCount: Anmeldungen
|
||||
ExamRegisteredCountOf num@Int64 count@Int64: #{num}/#{count}
|
||||
|
||||
NoFilter: Keine Einschränkung
|
||||
|
||||
|
||||
@ -26,7 +26,7 @@ getEShowR tid ssh csh examn = do
|
||||
cTime <- liftIO getCurrentTime
|
||||
mUid <- maybeAuthId
|
||||
|
||||
(Entity eId Exam{..}, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, bonus, occurrences, (registered, mayRegister), lecturerInfoShown) <- runDB $ do
|
||||
(Entity eId Exam{..}, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, bonus, occurrences, (registered, mayRegister), registeredCount, lecturerInfoShown) <- runDB $ do
|
||||
exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn
|
||||
|
||||
let examVisible = NTop (Just cTime) >= NTop examVisibleFrom
|
||||
@ -59,33 +59,43 @@ getEShowR tid ssh csh examn = do
|
||||
E.&&. examRegistration E.^. ExamRegistrationUser E.==. E.val uid
|
||||
E.&&. examRegistration E.^. ExamRegistrationOccurrence E.==. E.just (examOccurrence E.^. ExamOccurrenceId)
|
||||
| otherwise = E.false
|
||||
registeredCount :: E.SqlExpr (E.Value Int64)
|
||||
registeredCount
|
||||
= E.subSelectCount . E.from $ \examRegistration ->
|
||||
E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eId
|
||||
E.&&. examRegistration E.^. ExamRegistrationOccurrence E.==. E.just (examOccurrence E.^. ExamOccurrenceId)
|
||||
E.orderBy [E.desc registered, E.asc $ examOccurrence E.^. ExamOccurrenceStart, E.asc $ examOccurrence E.^. ExamOccurrenceRoom]
|
||||
return (examOccurrence, registered)
|
||||
return (examOccurrence, registered, registeredCount)
|
||||
|
||||
registeredCount <- fromIntegral <$> count [ ExamRegistrationExam ==. eId ]
|
||||
|
||||
registered <- for mUid $ getBy . UniqueExamRegistration eId
|
||||
mayRegister <- if
|
||||
| examOccurrenceRule == 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
|
||||
|
||||
let occurrences = sortOn sortPred $ map (over _2 E.unValue) occurrencesRaw
|
||||
let occurrences = sortOn sortPred $ map (over _3 E.unValue . over _2 E.unValue) occurrencesRaw
|
||||
where
|
||||
sortPred (Entity _ ExamOccurrence{..}, registered')
|
||||
sortPred (Entity _ ExamOccurrence{..}, registered', _)
|
||||
= (Down $ registered' && not mayRegister, examOccurrenceStart, examOccurrenceRoom)
|
||||
|
||||
lecturerInfoShown <- hasReadAccessTo $ CExamR tid ssh csh examn EEditR
|
||||
|
||||
return (exam, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, bonus, occurrences, (registered, mayRegister), lecturerInfoShown)
|
||||
return (exam, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, bonus, occurrences, (registered, mayRegister), registeredCount, lecturerInfoShown)
|
||||
|
||||
let occurrenceNamesShown = lecturerInfoShown
|
||||
partNumbersShown = lecturerInfoShown
|
||||
examClosedShown = lecturerInfoShown
|
||||
showCloseWidget = lecturerInfoShown
|
||||
showAutoOccurrenceCalculateWidget = lecturerInfoShown
|
||||
showRegisteredCount = lecturerInfoShown
|
||||
examFinishedMsg = if lecturerInfoShown then MsgExamFinished else MsgExamFinishedParticipant
|
||||
|
||||
sumMaxPoints = sum [ fromRational examPartWeight * mPoints | Entity _ ExamPart{..} <- examParts, mPoints <- examPartMaxPoints ^.. _Just ]
|
||||
|
||||
sumRegisteredCount = sumOf (folded . _3) occurrences
|
||||
|
||||
noBonus = fromMaybe False $ do
|
||||
guardM $ bonusOnlyPassed <$> examBonusRule
|
||||
return . fromMaybe True $ result ^? _Just . _entityVal . _examResultResult . _examResult . to (either id $ view passingGrade) . _Wrapped . to not
|
||||
@ -95,22 +105,22 @@ getEShowR tid ssh csh examn = do
|
||||
, guard (not noBonus) *> fmap (pure . Sum . examBonusBonus . entityVal) bonus
|
||||
]
|
||||
|
||||
hasRegistration = any snd occurrences
|
||||
hasRegistration = orOf (folded . _2) occurrences
|
||||
|
||||
mayRegister' <- fmap ((Map.!) . Map.fromList) . for (Nothing : map Just occurrences) $ \case
|
||||
Nothing ->
|
||||
fmap (Nothing, ) . hasWriteAccessTo $ CExamR tid ssh csh examName ERegisterR
|
||||
Just (Entity occId ExamOccurrence{..}, _) ->
|
||||
Just (Entity occId ExamOccurrence{..}, _, _) ->
|
||||
fmap (Just occId, ) . hasWriteAccessTo . CExamR tid ssh csh examName $ ERegisterOccR examOccurrenceName
|
||||
|
||||
let examTimes = all (\(Entity _ ExamOccurrence{..}, _) -> Just examOccurrenceStart == examStart && examOccurrenceEnd == examEnd) occurrences
|
||||
let examTimes = all (\(Entity _ ExamOccurrence{..}, _, _) -> Just examOccurrenceStart == examStart && examOccurrenceEnd == examEnd) occurrences
|
||||
examRoom = do
|
||||
Entity _ primeOcc <- occurrences ^? _head . _1
|
||||
guard $ all (\(Entity _ occ, _) -> examOccurrenceRoom occ == examOccurrenceRoom primeOcc) occurrences
|
||||
guard $ all (\(Entity _ occ, _, _) -> examOccurrenceRoom occ == examOccurrenceRoom primeOcc) occurrences
|
||||
return $ examOccurrenceRoom primeOcc
|
||||
registerWidget mOcc
|
||||
| isRegistered <- is _Just $ join registered
|
||||
, examOccurrenceRule /= ExamRoomFifo || (isRegistered && not (any snd occurrences))
|
||||
, examOccurrenceRule /= ExamRoomFifo || (isRegistered && not (orOf (folded . _2) occurrences))
|
||||
, mayRegister' (entityKey <$> mOcc) = Just $ do
|
||||
(examRegisterForm, examRegisterEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [BtnExamRegister] [BtnExamDeregister] isRegistered
|
||||
[whamlet|
|
||||
|
||||
@ -81,8 +81,13 @@ $maybe desc <- examDescription
|
||||
\ ^{isVisible False}
|
||||
<dd .deflist__dd>
|
||||
_{classifyExamOccurrenceRule examOccurrenceRule}
|
||||
$if showRegisteredCount
|
||||
<dt .deflist__dt>_{MsgExamRegisteredCount}
|
||||
<dd .deflist__dd>#{registeredCount}
|
||||
$maybe registerWdgt <- registerWidget Nothing
|
||||
<dt .deflist__dt>_{MsgExamRegistration}
|
||||
<dt .deflist__dt>
|
||||
_{MsgExamRegistration}
|
||||
\ ^{isVisible False}
|
||||
<dd .deflist__dd>^{registerWdgt}
|
||||
|
||||
$if showCloseWidget && is _Nothing examClosed
|
||||
@ -143,9 +148,13 @@ $if not (null occurrences)
|
||||
<th .table__td>
|
||||
$if not occurrenceAssignmentsVisible
|
||||
^{isVisible False}
|
||||
$if showRegisteredCount
|
||||
<th .table__th>
|
||||
_{MsgExamRegisteredCount}
|
||||
\ ^{isVisible False}
|
||||
<th .table__th>_{MsgExamRoomDescription}
|
||||
<tbody>
|
||||
$forall (occurrence, registered) <- occurrences
|
||||
$forall (occurrence, registered, rCount) <- occurrences
|
||||
$with Entity _occId ExamOccurrence{examOccurrenceName, examOccurrenceRoom, examOccurrenceStart, examOccurrenceEnd, examOccurrenceDescription} <- occurrence
|
||||
$with registerWdgt <- registerWidget (Just occurrence)
|
||||
<tr .table__row :markUnregisteredOccurrences (Just occurrence) && not registered:.occurrence--not-registered>
|
||||
@ -167,9 +176,31 @@ $if not (null occurrences)
|
||||
<td .table__td>
|
||||
$maybe mappingWgt <- occurrenceMapping examOccurrenceName
|
||||
^{mappingWgt}
|
||||
$if showRegisteredCount
|
||||
<td .table__td>#{rCount}
|
||||
<td .table__td>
|
||||
$maybe desc <- examOccurrenceDescription
|
||||
#{desc}
|
||||
<tfoot>
|
||||
<tr .table__row .table__row--sum>
|
||||
$if occurrenceNamesShown
|
||||
<td>
|
||||
$if is _Nothing examRoom
|
||||
<td>
|
||||
$if not examTimes
|
||||
<td>
|
||||
$if showOccurrenceRegisterColumn
|
||||
<td>
|
||||
$if showOccurrenceMappingColumn
|
||||
<td>
|
||||
$if showRegisteredCount
|
||||
<td .table__td>
|
||||
$if sumRegisteredCount == registeredCount
|
||||
#{sumRegisteredCount}
|
||||
$else
|
||||
_{MsgExamRegisteredCountOf sumRegisteredCount registeredCount}
|
||||
<td>
|
||||
|
||||
|
||||
$if gradingShown && not (null examParts)
|
||||
<section>
|
||||
|
||||
Loading…
Reference in New Issue
Block a user