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

feat(exams): show number of registrations to course admins

Browse Source
This commit is contained in:
Gregor Kleen 2020-05-15 12:07:03 +02:00
parent b6ec54cfec
commit ec020c5486
3 changed files with 56 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2447,6 +2447,8 @@ BtnExamAutoOccurrenceNudgeDown: -
ExamRoomMappingSurname: Nachnamen beginnend mit ExamRoomMappingSurname: Nachnamen beginnend mit
ExamRoomMappingMatriculation: Matrikelnummern endend in ExamRoomMappingMatriculation: Matrikelnummern endend in
ExamRoomLoad: Auslastung ExamRoomLoad: Auslastung
ExamRegisteredCount: Anmeldungen
ExamRegisteredCountOf num@Int64 count@Int64: #{num}/#{count}
NoFilter: Keine Einschränkung NoFilter: Keine Einschränkung

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

@ -26,7 +26,7 @@ getEShowR tid ssh csh examn = do
cTime <- liftIO getCurrentTime cTime <- liftIO getCurrentTime
mUid <- maybeAuthId 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 exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn
let examVisible = NTop (Just cTime) >= NTop examVisibleFrom 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.^. ExamRegistrationUser E.==. E.val uid
E.&&. examRegistration E.^. ExamRegistrationOccurrence E.==. E.just (examOccurrence E.^. ExamOccurrenceId) E.&&. examRegistration E.^. ExamRegistrationOccurrence E.==. E.just (examOccurrence E.^. ExamOccurrenceId)
| otherwise = E.false | 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] 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 registered <- for mUid $ getBy . UniqueExamRegistration eId
mayRegister <- if mayRegister <- if
| examOccurrenceRule == ExamRoomFifo -> anyM occurrencesRaw $ \(Entity _ ExamOccurrence{..}, _) -> | examOccurrenceRule == ExamRoomFifo -> anyM occurrencesRaw $ \(Entity _ ExamOccurrence{..}, _, _) ->
hasWriteAccessTo . CExamR tid ssh csh examName $ ERegisterOccR examOccurrenceName hasWriteAccessTo . CExamR tid ssh csh examName $ ERegisterOccR examOccurrenceName
| otherwise -> hasWriteAccessTo $ CExamR tid ssh csh examName ERegisterR | 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 where
sortPred (Entity _ ExamOccurrence{..}, registered') sortPred (Entity _ ExamOccurrence{..}, registered', _)
= (Down $ registered' && not mayRegister, examOccurrenceStart, examOccurrenceRoom) = (Down $ registered' && not mayRegister, examOccurrenceStart, examOccurrenceRoom)
lecturerInfoShown <- hasReadAccessTo $ CExamR tid ssh csh examn EEditR 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 let occurrenceNamesShown = lecturerInfoShown
partNumbersShown = lecturerInfoShown partNumbersShown = lecturerInfoShown
examClosedShown = lecturerInfoShown examClosedShown = lecturerInfoShown
showCloseWidget = lecturerInfoShown showCloseWidget = lecturerInfoShown
showAutoOccurrenceCalculateWidget = lecturerInfoShown showAutoOccurrenceCalculateWidget = lecturerInfoShown
showRegisteredCount = lecturerInfoShown
examFinishedMsg = if lecturerInfoShown then MsgExamFinished else MsgExamFinishedParticipant examFinishedMsg = if lecturerInfoShown then MsgExamFinished else MsgExamFinishedParticipant
sumMaxPoints = sum [ fromRational examPartWeight * mPoints | Entity _ ExamPart{..} <- examParts, mPoints <- examPartMaxPoints ^.. _Just ] sumMaxPoints = sum [ fromRational examPartWeight * mPoints | Entity _ ExamPart{..} <- examParts, mPoints <- examPartMaxPoints ^.. _Just ]
sumRegisteredCount = sumOf (folded . _3) occurrences
noBonus = fromMaybe False $ do noBonus = fromMaybe False $ do
guardM $ bonusOnlyPassed <$> examBonusRule guardM $ bonusOnlyPassed <$> examBonusRule
return . fromMaybe True $ result ^? _Just . _entityVal . _examResultResult . _examResult . to (either id $ view passingGrade) . _Wrapped . to not 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 , 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 mayRegister' <- fmap ((Map.!) . Map.fromList) . for (Nothing : map Just occurrences) $ \case
Nothing -> Nothing ->
fmap (Nothing, ) . hasWriteAccessTo $ CExamR tid ssh csh examName ERegisterR 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 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 examRoom = do
Entity _ primeOcc <- occurrences ^? _head . _1 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 return $ examOccurrenceRoom primeOcc
registerWidget mOcc registerWidget mOcc
| isRegistered <- is _Just $ join registered | 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 , mayRegister' (entityKey <$> mOcc) = Just $ do
(examRegisterForm, examRegisterEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [BtnExamRegister] [BtnExamDeregister] isRegistered (examRegisterForm, examRegisterEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [BtnExamRegister] [BtnExamDeregister] isRegistered
[whamlet| [whamlet|

35
templates/exam-show.hamlet
View File

@ -81,8 +81,13 @@ $maybe desc <- examDescription
\ ^{isVisible False} \ ^{isVisible False}
<dd .deflist__dd> <dd .deflist__dd>
_{classifyExamOccurrenceRule examOccurrenceRule} _{classifyExamOccurrenceRule examOccurrenceRule}
$if showRegisteredCount
<dt .deflist__dt>_{MsgExamRegisteredCount}
<dd .deflist__dd>#{registeredCount}
$maybe registerWdgt <- registerWidget Nothing $maybe registerWdgt <- registerWidget Nothing
<dt .deflist__dt>_{MsgExamRegistration} <dt .deflist__dt>
_{MsgExamRegistration}
\ ^{isVisible False}
<dd .deflist__dd>^{registerWdgt} <dd .deflist__dd>^{registerWdgt}
$if showCloseWidget && is _Nothing examClosed $if showCloseWidget && is _Nothing examClosed
@ -143,9 +148,13 @@ $if not (null occurrences)
<th .table__td> <th .table__td>
$if not occurrenceAssignmentsVisible $if not occurrenceAssignmentsVisible
^{isVisible False} ^{isVisible False}
$if showRegisteredCount
<th .table__th>
_{MsgExamRegisteredCount}
\ ^{isVisible False}
<th .table__th>_{MsgExamRoomDescription} <th .table__th>_{MsgExamRoomDescription}
<tbody> <tbody>
$forall (occurrence, registered) <- occurrences $forall (occurrence, registered, rCount) <- occurrences
$with Entity _occId ExamOccurrence{examOccurrenceName, examOccurrenceRoom, examOccurrenceStart, examOccurrenceEnd, examOccurrenceDescription} <- occurrence $with Entity _occId ExamOccurrence{examOccurrenceName, examOccurrenceRoom, examOccurrenceStart, examOccurrenceEnd, examOccurrenceDescription} <- occurrence
$with registerWdgt <- registerWidget (Just occurrence) $with registerWdgt <- registerWidget (Just occurrence)
<tr .table__row :markUnregisteredOccurrences (Just occurrence) && not registered:.occurrence--not-registered> <tr .table__row :markUnregisteredOccurrences (Just occurrence) && not registered:.occurrence--not-registered>
@ -167,9 +176,31 @@ $if not (null occurrences)
<td .table__td> <td .table__td>
$maybe mappingWgt <- occurrenceMapping examOccurrenceName $maybe mappingWgt <- occurrenceMapping examOccurrenceName
^{mappingWgt} ^{mappingWgt}
$if showRegisteredCount
<td .table__td>#{rCount}
<td .table__td> <td .table__td>
$maybe desc <- examOccurrenceDescription $maybe desc <- examOccurrenceDescription
#{desc} #{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) $if gradingShown && not (null examParts)
<section> <section>