diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 3af96a3fd..dd9febb1f 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -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 diff --git a/src/Handler/Exam/Show.hs b/src/Handler/Exam/Show.hs index ab6f799db..c86985c46 100644 --- a/src/Handler/Exam/Show.hs +++ b/src/Handler/Exam/Show.hs @@ -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| diff --git a/templates/exam-show.hamlet b/templates/exam-show.hamlet index 591420529..efb7f534d 100644 --- a/templates/exam-show.hamlet +++ b/templates/exam-show.hamlet @@ -81,8 +81,13 @@ $maybe desc <- examDescription \ ^{isVisible False}
_{classifyExamOccurrenceRule examOccurrenceRule} + $if showRegisteredCount +
_{MsgExamRegisteredCount} +
#{registeredCount} $maybe registerWdgt <- registerWidget Nothing -
_{MsgExamRegistration} +
+ _{MsgExamRegistration} + \ ^{isVisible False}
^{registerWdgt} $if showCloseWidget && is _Nothing examClosed @@ -143,9 +148,13 @@ $if not (null occurrences) $if not occurrenceAssignmentsVisible ^{isVisible False} + $if showRegisteredCount + + _{MsgExamRegisteredCount} + \ ^{isVisible False} _{MsgExamRoomDescription} - $forall (occurrence, registered) <- occurrences + $forall (occurrence, registered, rCount) <- occurrences $with Entity _occId ExamOccurrence{examOccurrenceName, examOccurrenceRoom, examOccurrenceStart, examOccurrenceEnd, examOccurrenceDescription} <- occurrence $with registerWdgt <- registerWidget (Just occurrence) @@ -167,9 +176,31 @@ $if not (null occurrences) $maybe mappingWgt <- occurrenceMapping examOccurrenceName ^{mappingWgt} + $if showRegisteredCount + #{rCount} $maybe desc <- examOccurrenceDescription #{desc} + + + $if occurrenceNamesShown + + $if is _Nothing examRoom + + $if not examTimes + + $if showOccurrenceRegisterColumn + + $if showOccurrenceMappingColumn + + $if showRegisteredCount + + $if sumRegisteredCount == registeredCount + #{sumRegisteredCount} + $else + _{MsgExamRegisteredCountOf sumRegisteredCount registeredCount} + + $if gradingShown && not (null examParts)