feat: support exam registration including room (ExamRoomFifo)
This commit is contained in:
Gregor Kleen
parent
66fd3c8c76
commit
14bb020fe9
@ -12,6 +12,7 @@ BtnCourseDeregister: Vom Kurs abmelden
|
||||
BtnCourseApply: Zum Kurs bewerben
|
||||
BtnCourseRetractApplication: Bewerbung zum Kurs zurückziehen
|
||||
BtnExamRegister: Anmelden zur Prüfung
|
||||
BtnExamRegisterOccurrence: Anmelden zum Prüfungstermin/-raum
|
||||
BtnExamDeregister: Von der Prüfung abmelden
|
||||
BtnHijack: Sitzung übernehmen
|
||||
BtnSave: Speichern
|
||||
@ -99,6 +100,7 @@ CourseCapacity: Kapazität
|
||||
CourseCapacityTip: Anzahl erlaubter Kursanmeldungen, leer lassen für unbeschränkte Kurskapazität
|
||||
CourseNoCapacity: In diesem Kurs sind keine Plätze mehr frei.
|
||||
TutorialNoCapacity: In dieser Übung sind keine Plätze mehr frei.
|
||||
ExamOccurrenceNoCapacity: Zu diesem Termin/Raum sind keine Plätze mehr frei.
|
||||
CourseNotEmpty: In diesem Kurs sind momentan Teilnehmer angemeldet.
|
||||
CourseRegistration: Kursanmeldung
|
||||
CourseRegisterOpen: Anmeldung möglich
|
||||
@ -409,6 +411,7 @@ UnauthorizedCorrectorAny: Sie sind nicht als Korrektor für eine Veranstaltung e
|
||||
UnauthorizedRegistered: Sie sind nicht als Teilnehmer für diese Veranstaltung registriert.
|
||||
UnauthorizedAllocationRegistered: Sie sind nicht als Teilnehmer für diese Zentralanmeldung registriert.
|
||||
UnauthorizedExamResult: Sie haben keine Ergebnisse in dieser Prüfung.
|
||||
UnauthorizedExamOccurrenceRegistration: Anmeldung zur Klausur erfolgt nicht inkl. Raum/Termin.
|
||||
UnauthorizedParticipant: Angegebener Benutzer ist nicht als Teilnehmer dieser Veranstaltung registriert.
|
||||
UnauthorizedParticipantSelf: Sie sind kein Teilnehmer dieser Veranstaltung.
|
||||
UnauthorizedApplicant: Angegebener Benutzer hat sich nicht für diese Veranstaltung beworben.
|
||||
@ -1263,6 +1266,8 @@ AuthTagAllocationRegistered: Nutzer nimmt an der Zentralanmeldung teil
|
||||
AuthTagTutorialRegistered: Nutzer ist Tutoriumsteilnehmer
|
||||
AuthTagExamRegistered: Nutzer ist Prüfungsteilnehmer
|
||||
AuthTagExamResult: Nutzer hat Prüfungsergebnisse
|
||||
AuthTagExamOccurrenceRegistered: Nutzer ist für Prüfungsraum/-termin angemeldet
|
||||
AuthTagExamOccurrenceRegistration: Anmeldung zur Klausur erfolgt inkl. Raum/Termin
|
||||
AuthTagParticipant: Nutzer ist mit Kurs assoziiert
|
||||
AuthTagApplicant: Nutzer ist mit Bewerber zum Kurs
|
||||
AuthTagRegisterGroup: Nutzer ist nicht Mitglied eines anderen Tutoriums mit der selben Registrierungs-Gruppe
|
||||
@ -1522,6 +1527,8 @@ ExamNoBonus': Kein automatischer Bonus
|
||||
ExamBonusPoints': Umrechnung von Übungspunkten
|
||||
ExamBonusManual': Manuelle Berechnung
|
||||
|
||||
ExamRegisterForOccurrence: Anmeldung zur Klausur erfolgt durch Anmeldung zu einem Termin/Raum
|
||||
|
||||
ExamBonusAchieved: Bonuspunkte
|
||||
|
||||
ExamEditHeading examn@ExamName: #{examn} bearbeiten
|
||||
@ -1534,17 +1541,19 @@ 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 Termin- bzw. Raumzuteilung
|
||||
ExamAutomaticOccurrenceAssignmentTip: Sollen Prüfungsteilnehmer automatisch auf die zur Verfügung stehenden Räume bzw. Termine verteilt werden? Manuelle Umverteilung bzw. vorheriges Festlegen von Zuteilungen einzelner Teilnehmer ist trotzdem möglich.
|
||||
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.
|
||||
ExamOccurrenceRule: Verfahren
|
||||
ExamOccurrenceRuleParticipant: Termin- bzw. Raumzuteilungsverfahren
|
||||
ExamRoomManual': Keine automatische Zuteilung
|
||||
ExamRoomManual': Keine automatische bzw. selbstständige Zuteilung
|
||||
ExamRoomSurname': Nach Nachname
|
||||
ExamRoomMatriculation': Nach Matrikelnummer
|
||||
ExamRoomRandom': Zufällig pro Teilnehmer
|
||||
ExamRoomFifo': Auswahl durch Teilnehmer bei Anmeldung
|
||||
|
||||
ExamOccurrence: Termin/Raum
|
||||
ExamNoOccurrence: Kein Termin/Raum
|
||||
ExamNoSuchOccurrence: Termin/Raum existiert nicht (mehr)
|
||||
ExamOccurrences: Prüfungen
|
||||
ExamRooms: Räume
|
||||
ExamRoomAlreadyExists: Prüfung ist bereits eingetragen
|
||||
@ -1557,7 +1566,8 @@ ExamRoomStart: Beginn
|
||||
ExamRoomEnd: Ende
|
||||
ExamRoomDescription: Beschreibung
|
||||
ExamTimeTip: Nur zur Information der Studierenden, die tatsächliche Zeitangabe erfolgt pro Prüfung
|
||||
ExamRoomRegistered: Zugeteilt
|
||||
ExamRoomAssigned: Zugeteilt
|
||||
ExamRoomRegistered: Anmeldung
|
||||
|
||||
ExamOccurrenceStart: Prüfungsbeginn
|
||||
|
||||
@ -1603,6 +1613,7 @@ ExamDeregisteredSuccess exam@ExamName: Erfolgreich von der Prüfung #{exam} abge
|
||||
ExamRegistered: Zur Prüfung angemeldet
|
||||
ExamNotRegistered: Nicht zur Prüfung angemeldet
|
||||
ExamRegistration: Prüfungsanmeldung
|
||||
ExamLoginToRegister: Um sich zum Kurs anzumelden müssen Sie zunächst in Uni2work anmelden
|
||||
|
||||
ExamRegisterToMustBeAfterRegisterFrom: "Anmeldung ab" muss vor "Anmeldung bis" liegen
|
||||
ExamDeregisterUntilMustBeAfterRegisterFrom: "Abmeldung bis" muss nach "Anmeldung bis" liegen
|
||||
|
||||
@ -12,6 +12,7 @@ BtnCourseDeregister: Leave course
|
||||
BtnCourseApply: Apply for course
|
||||
BtnCourseRetractApplication: Retract application
|
||||
BtnExamRegister: Enrol for exam
|
||||
BtnExamRegisterOccurrence: Enrol for exam occurrence/room
|
||||
BtnExamDeregister: Leave exam
|
||||
BtnHijack: Hijack session
|
||||
BtnSave: Save
|
||||
@ -99,6 +100,7 @@ CourseCapacity: Capacity
|
||||
CourseCapacityTip: Maximum permissable number of enrolments for this course; leave empty for unlimited capacity
|
||||
CourseNoCapacity: Course has reached maximum capacity
|
||||
TutorialNoCapacity: Tutorial has reached maximum capacity
|
||||
ExamOccurrenceNoCapacity: Occurrence/Room has reached maximum capacity
|
||||
CourseNotEmpty: There are currently no participants enrolled for this course.
|
||||
CourseRegistration: Enrolment
|
||||
CourseRegisterOpen: Enrolment is allowed
|
||||
@ -407,6 +409,7 @@ UnauthorizedCorrectorAny: You are no corrector for any course.
|
||||
UnauthorizedRegistered: You are no participant in this course.
|
||||
UnauthorizedAllocationRegistered: You are no participant in this central allocation.
|
||||
UnauthorizedExamResult: You have no results in this exam.
|
||||
UnauthorizedExamOccurrenceRegistration: Registration for exam is not done including occurrence/room.
|
||||
UnauthorizedParticipant: The specified user is no participant of this course.
|
||||
UnauthorizedParticipantSelf: You are no participant of this course.
|
||||
UnauthorizedApplicant: The specified user is no applicant for this course.
|
||||
@ -1262,6 +1265,8 @@ AuthTagAllocationRegistered: User participates in central allocation
|
||||
AuthTagTutorialRegistered: User is tutorial participant
|
||||
AuthTagExamRegistered: User is exam participant
|
||||
AuthTagExamResult: User has an exam result
|
||||
AuthTagExamOccurrenceRegistered: User is registered for exam occurrence/room
|
||||
AuthTagExamOccurrenceRegistration: Registration for exam is done including occurrence/room
|
||||
AuthTagParticipant: User participates in course
|
||||
AuthTagApplicant: User is applicant for course
|
||||
AuthTagRegisterGroup: User is not participant in any tutorial of the same registration group
|
||||
@ -1520,6 +1525,8 @@ ExamNoBonus': No automatic exam bonus
|
||||
ExamBonusPoints': Compute from exercise achievements
|
||||
ExamBonusManual': Manual computation
|
||||
|
||||
ExamRegisterForOccurrence: Registration for this exam is done by registering for an occurrence/room
|
||||
|
||||
ExamBonusAchieved: Bonus points
|
||||
|
||||
ExamEditHeading examn: Edit #{examn}
|
||||
@ -1532,17 +1539,19 @@ ExamBonusRound: Round bonus to
|
||||
ExamBonusRoundNonPositive: Rounding multiple must be positive and greater than zero
|
||||
ExamBonusRoundTip: Bonus points are rounded commercially to a multiple of the given number
|
||||
|
||||
ExamAutomaticOccurrenceAssignment: Automatically assign occurrence/room
|
||||
ExamAutomaticOccurrenceAssignmentTip: Should exam participants be distributed automatically among the configured occurrences/rooms? Manipulation of the distribution and manually assigning participants remains possible.
|
||||
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.
|
||||
ExamOccurrenceRule: Procedure
|
||||
ExamOccurrenceRuleParticipant: Occurrence/room assignment procedure
|
||||
ExamRoomManual': No automatic assignment
|
||||
ExamRoomManual': No automatic or autonomous assignment
|
||||
ExamRoomSurname': By surname
|
||||
ExamRoomMatriculation': By matriculation
|
||||
ExamRoomRandom': Randomly
|
||||
ExamRoomFifo': Selected by the participants when registering
|
||||
|
||||
ExamOccurrence: Occurrence/room
|
||||
ExamNoOccurrence: No occurrence/room
|
||||
ExamNoSuchOccurrence: Occurrence/Room does not exist (anymore)
|
||||
ExamOccurrences: Exams
|
||||
ExamRooms: Rooms
|
||||
ExamRoomAlreadyExists: Occurrence already configured
|
||||
@ -1555,7 +1564,8 @@ ExamRoomStart: Start
|
||||
ExamRoomEnd: End
|
||||
ExamRoomDescription: Description
|
||||
ExamTimeTip: Only for informational purposes. The actual times are set for each occurrence/room
|
||||
ExamRoomRegistered: Assigned
|
||||
ExamRoomAssigned: Assigned
|
||||
ExamRoomRegistered: Registration
|
||||
|
||||
ExamOccurrenceStart: Exam starts
|
||||
|
||||
@ -1601,6 +1611,7 @@ ExamDeregisteredSuccess exam: Successufly deregistered from the exam #{exam}
|
||||
ExamRegistered: Registered for the exam
|
||||
ExamNotRegistered: Not registered for the exam
|
||||
ExamRegistration: Exam registration
|
||||
ExamLoginToRegister: Your need to login to Uni2work before you can register for this course.
|
||||
|
||||
ExamRegisterToMustBeAfterRegisterFrom: "Register to" must be after "register from"
|
||||
ExamDeregisterUntilMustBeAfterRegisterFrom: "Deregister until" must be after "register from"
|
||||
|
||||
1
routes
1
routes
@ -173,6 +173,7 @@
|
||||
/users/new EAddUserR GET POST
|
||||
/users/invite EInviteR GET POST
|
||||
/register ERegisterR POST !timeANDcourse-registeredAND¬exam-registered !timeANDexam-registeredAND¬exam-result
|
||||
/register/#ExamOccurrenceName ERegisterOccR POST !exam-occurrence-registrationANDtimeANDcapacityANDcourse-registeredAND¬exam-occurrence-registered !exam-occurrence-registrationANDtimeANDexam-occurrence-registeredAND¬exam-result
|
||||
/grades EGradesR GET POST !exam-office
|
||||
/apps CApplicationsR GET POST
|
||||
!/apps/files CAppsFilesR GET
|
||||
|
||||
@ -504,9 +504,9 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
|
||||
course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
|
||||
Entity eId Exam{..} <- $cachedHereBinary (course, examn) . MaybeT . getBy $ UniqueExam course examn
|
||||
cTime <- liftIO getCurrentTime
|
||||
registered <- case mAuthId of
|
||||
Just uid -> $cachedHereBinary (eId, uid) . lift . existsBy $ UniqueExamRegistration eId uid
|
||||
Nothing -> return False
|
||||
registration <- case mAuthId of
|
||||
Just uid -> $cachedHereBinary (eId, uid) . lift . getBy $ UniqueExamRegistration eId uid
|
||||
Nothing -> return Nothing
|
||||
|
||||
let visible = NTop examVisibleFrom <= NTop (Just cTime)
|
||||
|
||||
@ -515,11 +515,23 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
|
||||
EUsersR -> guard $ NTop examStart <= NTop (Just cTime)
|
||||
&& NTop (Just cTime) <= NTop examFinished
|
||||
ERegisterR
|
||||
| not registered -> guard $ visible
|
||||
&& NTop examRegisterFrom <= NTop (Just cTime)
|
||||
&& NTop (Just cTime) <= NTop examRegisterTo
|
||||
| otherwise -> guard $ visible
|
||||
&& NTop (Just cTime) <= NTop examDeregisterUntil
|
||||
| is _Nothing registration
|
||||
-> guard $ visible
|
||||
&& NTop examRegisterFrom <= NTop (Just cTime)
|
||||
&& NTop (Just cTime) <= NTop examRegisterTo
|
||||
| otherwise
|
||||
-> guard $ visible
|
||||
&& NTop (Just cTime) <= NTop examDeregisterUntil
|
||||
ERegisterOccR occn -> do
|
||||
occId <- (>>= hoistMaybe) . $cachedHereBinary (eId, occn) . lift . getKeyBy $ UniqueExamOccurrence eId occn
|
||||
if
|
||||
| (registration >>= examRegistrationOccurrence . entityVal) == Just occId
|
||||
-> guard $ visible
|
||||
&& NTop (Just cTime) <= NTop examDeregisterUntil
|
||||
| otherwise
|
||||
-> guard $ visible
|
||||
&& NTop examRegisterFrom <= NTop (Just cTime)
|
||||
&& NTop (Just cTime) <= NTop examRegisterTo
|
||||
_ -> return ()
|
||||
|
||||
return Authorized
|
||||
@ -758,6 +770,59 @@ tagAccessPredicate AuthTutorialRegistered = APDB $ \mAuthId route _ -> case rout
|
||||
guardMExceptT isRegistered (unauthorizedI MsgUnauthorizedRegistered)
|
||||
return Authorized
|
||||
r -> $unsupportedAuthPredicate AuthTutorialRegistered r
|
||||
tagAccessPredicate AuthExamOccurrenceRegistration = APDB $ \_ route _ -> case route of
|
||||
CExamR tid ssh csh examn _ -> exceptT return return $ do
|
||||
isOccurrenceRegistration <- $cachedHereBinary (tid, ssh, csh, examn) . lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam) -> do
|
||||
E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
|
||||
E.where_ $ course E.^. CourseTerm E.==. E.val tid
|
||||
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)
|
||||
guardMExceptT isOccurrenceRegistration (unauthorizedI MsgUnauthorizedExamOccurrenceRegistration)
|
||||
return Authorized
|
||||
r -> $unsupportedAuthPredicate AuthExamOccurrenceRegistration r
|
||||
tagAccessPredicate AuthExamOccurrenceRegistered = APDB $ \mAuthId route _ -> case route of
|
||||
CExamR tid ssh csh examn (ERegisterOccR occn) -> exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
hasRegistration <- $cachedHereBinary (authId, tid, ssh, csh, examn, occn) . lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examRegistration `E.InnerJoin` examOccurrence) -> do
|
||||
E.on $ E.just (examOccurrence E.^. ExamOccurrenceId) E.==. examRegistration E.^. ExamRegistrationOccurrence
|
||||
E.on $ exam E.^. ExamId E.==. examRegistration E.^. ExamRegistrationExam
|
||||
E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
|
||||
E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val authId
|
||||
E.&&. examOccurrence E.^. ExamOccurrenceName E.==. E.val occn
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
E.&&. exam E.^. ExamName E.==. E.val examn
|
||||
guardMExceptT hasRegistration (unauthorizedI MsgUnauthorizedRegistered)
|
||||
return Authorized
|
||||
CExamR tid ssh csh examn _ -> exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
hasRegistration <- $cachedHereBinary (authId, tid, ssh, csh, examn) . lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examRegistration) -> do
|
||||
E.on $ exam E.^. ExamId E.==. examRegistration E.^. ExamRegistrationExam
|
||||
E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
|
||||
E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val authId
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
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.&&. E.not_ (E.isNothing $ examRegistration E.^. ExamRegistrationOccurrence)
|
||||
guardMExceptT hasRegistration (unauthorizedI MsgUnauthorizedRegistered)
|
||||
return Authorized
|
||||
CourseR tid ssh csh _ -> exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
hasRegistration <- $cachedHereBinary (authId, tid, ssh, csh) . lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examRegistration) -> do
|
||||
E.on $ exam E.^. ExamId E.==. examRegistration E.^. ExamRegistrationExam
|
||||
E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
|
||||
E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val authId
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
E.&&. E.not_ (E.isNothing $ examRegistration E.^. ExamRegistrationOccurrence)
|
||||
guardMExceptT hasRegistration (unauthorizedI MsgUnauthorizedRegistered)
|
||||
return Authorized
|
||||
r -> $unsupportedAuthPredicate AuthExamOccurrenceRegistered r
|
||||
tagAccessPredicate AuthExamRegistered = APDB $ \mAuthId route _ -> case route of
|
||||
CExamR tid ssh csh examn _ -> exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
@ -768,7 +833,7 @@ tagAccessPredicate AuthExamRegistered = APDB $ \mAuthId route _ -> case route of
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
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.^. ExamName E.==. E.val examn
|
||||
guardMExceptT hasRegistration (unauthorizedI MsgUnauthorizedRegistered)
|
||||
return Authorized
|
||||
CourseR tid ssh csh _ -> exceptT return return $ do
|
||||
@ -933,6 +998,13 @@ tagAccessPredicate AuthApplicant = APDB $ \mAuthId route _ -> case route of
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
tagAccessPredicate AuthCapacity = APDB $ \_ route _ -> case route of
|
||||
CExamR tid ssh csh examn (ERegisterOccR occn) -> maybeT (unauthorizedI MsgExamOccurrenceNoCapacity) $ do
|
||||
cid <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
|
||||
eid <- $cachedHereBinary (cid, examn) . MaybeT . getKeyBy $ UniqueExam cid examn
|
||||
Entity occId ExamOccurrence{..} <- $cachedHereBinary (eid, occn) . MaybeT . getBy $ UniqueExamOccurrence eid occn
|
||||
registered <- $cachedHereBinary occId . lift $ fromIntegral <$> count [ ExamRegistrationOccurrence ==. Just occId, ExamRegistrationExam ==. eid ]
|
||||
guard $ examOccurrenceCapacity > registered
|
||||
return Authorized
|
||||
CTutorialR tid ssh csh tutn _ -> maybeT (unauthorizedI MsgTutorialNoCapacity) $ do
|
||||
cid <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
|
||||
Entity tutId Tutorial{..} <- $cachedHereBinary (cid, tutn) . MaybeT . getBy $ UniqueTutorial cid tutn
|
||||
@ -1791,6 +1863,7 @@ instance YesodBreadcrumbs UniWorX where
|
||||
ECInviteR -> i18nCrumb MsgBreadcrumbExamCorrectorInvite . Just $ CExamR tid ssh csh examn EShowR
|
||||
EInviteR -> i18nCrumb MsgBreadcrumbExamParticipantInvite . Just $ CExamR tid ssh csh examn EShowR
|
||||
ERegisterR -> i18nCrumb MsgBreadcrumbExamRegister . Just $ CExamR tid ssh csh examn EShowR
|
||||
ERegisterOccR _occn -> i18nCrumb MsgBreadcrumbExamRegister . Just $ CExamR tid ssh csh examn EShowR
|
||||
|
||||
breadcrumb (CourseR tid ssh csh (TutorialR tutn sRoute)) = case sRoute of
|
||||
TUsersR -> maybeT (i18nCrumb MsgBreadcrumbTutorial . Just $ CourseR tid ssh csh CTutorialListR) $ do
|
||||
|
||||
@ -1,6 +1,7 @@
|
||||
module Handler.Exam.Register
|
||||
( ButtonExamRegister(..)
|
||||
, postERegisterR
|
||||
, postERegisterOccR
|
||||
) where
|
||||
|
||||
import Import
|
||||
@ -8,45 +9,81 @@ import Import
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Exam
|
||||
|
||||
import Database.Persist.Sql (deleteWhereCount)
|
||||
|
||||
|
||||
-- Dedicated ExamRegistrationButton
|
||||
data ButtonExamRegister = BtnExamRegister | BtnExamDeregister
|
||||
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
|
||||
data ButtonExamRegister = BtnExamRegisterOccurrence
|
||||
| BtnExamRegister
|
||||
| BtnExamDeregister
|
||||
deriving (Enum, Bounded, Eq, Ord, Read, Show, Generic, Typeable)
|
||||
instance Universe ButtonExamRegister
|
||||
instance Finite ButtonExamRegister
|
||||
nullaryPathPiece ''ButtonExamRegister $ camelToPathPiece' 1
|
||||
embedRenderMessage ''UniWorX ''ButtonExamRegister id
|
||||
nullaryPathPiece ''ButtonExamRegister $ camelToPathPiece' 2
|
||||
|
||||
instance Button UniWorX ButtonExamRegister where
|
||||
btnClasses BtnExamRegister = [BCIsButton, BCPrimary]
|
||||
btnClasses BtnExamDeregister = [BCIsButton, BCDanger]
|
||||
btnClasses BtnExamRegisterOccurrence = [BCIsButton, BCPrimary]
|
||||
btnClasses BtnExamRegister = [BCIsButton, BCPrimary]
|
||||
btnClasses BtnExamDeregister = [BCIsButton, BCDanger]
|
||||
|
||||
btnLabel BtnExamRegister = [whamlet|#{iconExamRegister True} _{MsgBtnExamRegister}|]
|
||||
btnLabel BtnExamDeregister = [whamlet|#{iconExamRegister False} _{MsgBtnExamDeregister}|]
|
||||
btnLabel BtnExamRegisterOccurrence = [whamlet|#{iconExamRegister True } _{MsgBtnExamRegisterOccurrence}|]
|
||||
btnLabel BtnExamRegister = [whamlet|#{iconExamRegister True } _{MsgBtnExamRegister}|]
|
||||
btnLabel BtnExamDeregister = [whamlet|#{iconExamRegister False} _{MsgBtnExamDeregister}|]
|
||||
|
||||
|
||||
postERegisterR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
|
||||
|
||||
postERegisterR tid ssh csh examn = do
|
||||
Entity uid User{..} <- requireAuth
|
||||
|
||||
Entity eId Exam{..} <- runDB $ fetchExam tid ssh csh examn
|
||||
|
||||
((btnResult, _), _) <- runFormPost buttonForm
|
||||
((btnResult, _), _) <- runFormPost $ buttonForm' [BtnExamRegister, BtnExamDeregister]
|
||||
|
||||
formResult btnResult $ \case
|
||||
BtnExamDeregister -> do
|
||||
runDB $ do
|
||||
deleted <- deleteWhereCount [ExamRegistrationExam ==. eId, ExamRegistrationUser ==. uid]
|
||||
unless (deleted <= 0) $
|
||||
audit $ TransactionExamDeregister eId uid
|
||||
addMessageIconI Success IconExamRegisterFalse $ MsgExamDeregisteredSuccess examn
|
||||
redirect $ CExamR tid ssh csh examn EShowR
|
||||
BtnExamRegister -> do
|
||||
runDB $ do
|
||||
now <- liftIO getCurrentTime
|
||||
insert_ $ ExamRegistration eId uid Nothing now
|
||||
void $ upsertBy (UniqueExamRegistration eId uid) (ExamRegistration eId uid Nothing now) [ExamRegistrationTime =. now]
|
||||
audit $ TransactionExamRegister eId uid
|
||||
addMessageIconI Success IconExamRegisterTrue $ MsgExamRegisteredSuccess examn
|
||||
addMessageIconI Success IconExamRegisterTrue $ MsgExamRegisteredSuccess examn
|
||||
redirect $ CExamR tid ssh csh examn EShowR
|
||||
_other -> error "Unexpected due to definition of buttonForm'"
|
||||
|
||||
redirect $ CExamR tid ssh csh examn EShowR
|
||||
|
||||
postERegisterOccR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> ExamOccurrenceName -> Handler Html
|
||||
postERegisterOccR tid ssh csh examn occn = do
|
||||
Entity uid User{..} <- requireAuth
|
||||
(Entity eId Exam{..}, Entity occId ExamOccurrence{..}) <- runDB $ do
|
||||
eexam@(Entity eId _) <- fetchExam tid ssh csh examn
|
||||
occ <- getBy404 $ UniqueExamOccurrence eId occn
|
||||
return (eexam, occ)
|
||||
|
||||
((btnResult, _), _) <- runFormPost buttonForm
|
||||
|
||||
formResult btnResult $ \case
|
||||
BtnExamDeregister -> do
|
||||
runDB $ do
|
||||
deleteBy $ UniqueExamRegistration eId uid
|
||||
audit $ TransactionExamDeregister eId uid
|
||||
addMessageIconI Info IconExamRegisterFalse $ MsgExamDeregisteredSuccess examn
|
||||
-- yes, it's a success message, but it should be visually different from a positive success, since most will just note the positive green color! See discussion on commit 5f4925a4
|
||||
deleted <- deleteWhereCount [ExamRegistrationExam ==. eId, ExamRegistrationUser ==. uid]
|
||||
unless (deleted <= 0) $
|
||||
audit $ TransactionExamDeregister eId uid
|
||||
addMessageIconI Success IconExamRegisterFalse $ MsgExamDeregisteredSuccess examn
|
||||
redirect $ CExamR tid ssh csh examn EShowR
|
||||
BtnExamRegisterOccurrence -> do
|
||||
runDB $ do
|
||||
now <- liftIO getCurrentTime
|
||||
void $ upsertBy (UniqueExamRegistration eId uid) (ExamRegistration eId uid (Just occId) now) [ExamRegistrationOccurrence =. Just occId, ExamRegistrationTime =. now]
|
||||
audit $ TransactionExamRegister eId uid
|
||||
addMessageIconI Success IconExamRegisterTrue $ MsgExamRegisteredSuccess examn
|
||||
redirect $ CExamR tid ssh csh examn EShowR
|
||||
_other -> error "Unexpected due to definition of buttonForm'"
|
||||
|
||||
invalidArgs ["Register/Deregister button required"]
|
||||
redirect $ CExamR tid ssh csh examn EShowR
|
||||
|
||||
|
||||
@ -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
|
||||
let occurrenceAssignmentsVisible = NTop (Just cTime) >= NTop examPublishOccurrenceAssignments || examOccurrenceRule == Just ExamRoomFifo
|
||||
occurrenceAssignmentsShown <- or2M (return occurrenceAssignmentsVisible) . hasReadAccessTo $ CExamR tid ssh csh examn EEditR
|
||||
|
||||
examParts <- sortOn (view $ _entityVal . _examPartNumber) <$> selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ]
|
||||
@ -58,10 +58,16 @@ getEShowR tid ssh csh examn = do
|
||||
E.orderBy [E.desc registered, E.asc $ examOccurrence E.^. ExamOccurrenceStart, E.asc $ examOccurrence E.^. ExamOccurrenceRoom]
|
||||
return (examOccurrence, registered)
|
||||
|
||||
let occurrences = map (over _2 E.unValue) occurrencesRaw
|
||||
registered <- for mUid $ getBy . UniqueExamRegistration eId
|
||||
mayRegister <- if
|
||||
| examOccurrenceRule == Just ExamRoomFifo -> anyM occurrencesRaw $ \(Entity _ ExamOccurrence{..}, _) ->
|
||||
hasWriteAccessTo . CExamR tid ssh csh examName $ ERegisterOccR examOccurrenceName
|
||||
| otherwise -> hasWriteAccessTo $ CExamR tid ssh csh examName ERegisterR
|
||||
|
||||
registered <- for mUid $ existsBy . UniqueExamRegistration eId
|
||||
mayRegister <- (== Authorized) <$> evalAccessDB (CExamR tid ssh csh examName ERegisterR) True
|
||||
let occurrences = sortOn sortPred $ map (over _2 E.unValue) occurrencesRaw
|
||||
where
|
||||
sortPred (Entity _ ExamOccurrence{..}, registered')
|
||||
= (Down $ registered' && not mayRegister, examOccurrenceStart, examOccurrenceRoom)
|
||||
|
||||
lecturerInfoShown <- hasReadAccessTo $ CExamR tid ssh csh examn EEditR
|
||||
|
||||
@ -83,12 +89,18 @@ getEShowR tid ssh csh examn = do
|
||||
]
|
||||
|
||||
hasRegistration = any snd 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{..}, _) ->
|
||||
fmap (Just occId, ) . hasWriteAccessTo . CExamR tid ssh csh examName $ ERegisterOccR examOccurrenceName
|
||||
|
||||
let examTimes = all (\(Entity _ ExamOccurrence{..}, _) -> Just examOccurrenceStart == examStart && examOccurrenceEnd == examEnd) occurrences
|
||||
registerWidget
|
||||
| Just isRegistered <- registered
|
||||
, mayRegister = Just $ do
|
||||
registerWidget mOcc
|
||||
| isRegistered <- is _Just $ join registered
|
||||
, examOccurrenceRule /= Just ExamRoomFifo || (isRegistered && not (any snd occurrences))
|
||||
, mayRegister' (entityKey <$> mOcc) = Just $ do
|
||||
(examRegisterForm, examRegisterEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [BtnExamRegister] [BtnExamDeregister] isRegistered
|
||||
[whamlet|
|
||||
<p>
|
||||
@ -102,11 +114,37 @@ getEShowR tid ssh csh examn = do
|
||||
, formEncoding = examRegisterEnctype
|
||||
, formSubmit = FormNoSubmit
|
||||
}
|
||||
| fromMaybe False registered = Just [whamlet|_{MsgExamRegistered}|]
|
||||
| examOccurrenceRule == Just ExamRoomFifo
|
||||
, Just (Entity occId ExamOccurrence{..}) <- mOcc
|
||||
, isRegistered <- (== Just occId) $ examRegistrationOccurrence . entityVal =<< join registered
|
||||
, mayRegister' (Just occId) = Just $ do
|
||||
(examRegisterForm, examRegisterEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [BtnExamRegisterOccurrence] [BtnExamDeregister] isRegistered
|
||||
wrapForm examRegisterForm def
|
||||
{ formAction = Just . SomeRoute . CExamR tid ssh csh examName $ ERegisterOccR examOccurrenceName
|
||||
, formEncoding = examRegisterEnctype
|
||||
, formSubmit = FormNoSubmit
|
||||
}
|
||||
| is _Nothing mOcc
|
||||
, is _Nothing registered
|
||||
= Just [whamlet|_{MsgExamLoginToRegister}|]
|
||||
| is _Nothing mOcc
|
||||
, isRegistered <- is _Just $ join registered
|
||||
= Just
|
||||
[whamlet|
|
||||
<p>
|
||||
$if isRegistered
|
||||
_{MsgExamRegistered}
|
||||
$else
|
||||
_{MsgExamNotRegistered}
|
||||
$if mayRegister
|
||||
^{messageTooltip =<< messageI Info MsgExamRegisterForOccurrence}
|
||||
|]
|
||||
| otherwise = Nothing
|
||||
|
||||
showMaxPoints = any (has $ _entityVal . _examPartMaxPoints . _Just) examParts
|
||||
showAchievedPoints = not $ null results
|
||||
showOccurrenceRegisterColumn = occurrenceAssignmentsShown || (mayRegister && examOccurrenceRule == Just ExamRoomFifo)
|
||||
markUnregisteredOccurrences mOcc = occurrenceAssignmentsShown && hasRegistration && isn't _Just (registerWidget mOcc)
|
||||
|
||||
let heading = prependCourseTitle tid ssh csh $ CI.original examName
|
||||
|
||||
|
||||
@ -557,6 +557,7 @@ examBonusRuleForm prev = multiActionA actions (fslI MsgExamBonusRule) $ classify
|
||||
data ExamOccurrenceRule' = ExamRoomSurname'
|
||||
| ExamRoomMatriculation'
|
||||
| ExamRoomRandom'
|
||||
| ExamRoomFifo'
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
instance Universe ExamOccurrenceRule'
|
||||
instance Finite ExamOccurrenceRule'
|
||||
@ -569,6 +570,7 @@ classifyExamOccurrenceRule = \case
|
||||
ExamRoomSurname -> ExamRoomSurname'
|
||||
ExamRoomMatriculation -> ExamRoomMatriculation'
|
||||
ExamRoomRandom -> ExamRoomRandom'
|
||||
ExamRoomFifo -> ExamRoomFifo'
|
||||
|
||||
examOccurrenceRuleForm :: Maybe ExamOccurrenceRule -> AForm Handler ExamOccurrenceRule
|
||||
examOccurrenceRuleForm = fmap reverseClassify . areq (selectField optionsFinite) (fslI MsgExamOccurrenceRule) . fmap classifyExamOccurrenceRule
|
||||
@ -577,6 +579,7 @@ examOccurrenceRuleForm = fmap reverseClassify . areq (selectField optionsFinite)
|
||||
ExamRoomSurname' -> ExamRoomSurname
|
||||
ExamRoomMatriculation' -> ExamRoomMatriculation
|
||||
ExamRoomRandom' -> ExamRoomRandom
|
||||
ExamRoomFifo' -> ExamRoomFifo
|
||||
|
||||
data ExamGradingRule' = ExamGradingKey'
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
|
||||
@ -139,6 +139,7 @@ derivePersistFieldJSON ''ExamBonusRule
|
||||
data ExamOccurrenceRule = ExamRoomSurname
|
||||
| ExamRoomMatriculation
|
||||
| ExamRoomRandom
|
||||
| ExamRoomFifo
|
||||
deriving (Show, Read, Eq, Ord, Generic, Typeable)
|
||||
deriveJSON defaultOptions
|
||||
{ fieldLabelModifier = camelToPathPiece' 1
|
||||
|
||||
@ -54,6 +54,8 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä
|
||||
| AuthCourseRegistered
|
||||
| AuthTutorialRegistered
|
||||
| AuthExamRegistered
|
||||
| AuthExamOccurrenceRegistered
|
||||
| AuthExamOccurrenceRegistration
|
||||
| AuthExamResult
|
||||
| AuthParticipant
|
||||
| AuthApplicant
|
||||
|
||||
@ -84,7 +84,7 @@ $maybe desc <- examDescription
|
||||
\ ^{isVisible False}
|
||||
<dd .deflist__dd>
|
||||
_{classifyExamOccurrenceRule occurrenceRule}
|
||||
$maybe registerWdgt <- registerWidget
|
||||
$maybe registerWdgt <- registerWidget Nothing
|
||||
<dt .deflist__dt>_{MsgExamRegistration}
|
||||
<dd .deflist__dd>^{registerWdgt}
|
||||
|
||||
@ -103,31 +103,39 @@ $if not (null occurrences)
|
||||
<th .table__th>
|
||||
_{MsgExamRoomName}
|
||||
\ ^{isVisible False}
|
||||
$if occurrenceAssignmentsShown
|
||||
<th .table__th>
|
||||
_{MsgExamRoomRegistered}
|
||||
$if not occurrenceAssignmentsVisible
|
||||
\ ^{isVisible False}
|
||||
<th .table__th>_{MsgExamRoom}
|
||||
$if not examTimes
|
||||
<th .table__th>_{MsgExamRoomTime}
|
||||
$if showOccurrenceRegisterColumn
|
||||
<th .table__th>
|
||||
$if examOccurrenceRule == Just ExamRoomFifo
|
||||
_{MsgExamRoomRegistered}
|
||||
$else
|
||||
_{MsgExamRoomAssigned}
|
||||
$if not occurrenceAssignmentsVisible
|
||||
\ ^{isVisible False}
|
||||
<th .table__th>_{MsgExamRoomDescription}
|
||||
<tbody>
|
||||
$forall (Entity _occId ExamOccurrence{examOccurrenceName, examOccurrenceRoom, examOccurrenceStart, examOccurrenceEnd, examOccurrenceDescription}, registered) <- occurrences
|
||||
<tr .table__row :occurrenceAssignmentsShown && (not registered && hasRegistration):.occurrence--not-registered>
|
||||
$if occurrenceNamesShown
|
||||
<td .table__td #exam-occurrence__#{examOccurrenceName}>#{examOccurrenceName}
|
||||
$if occurrenceAssignmentsShown
|
||||
<td .table__td>
|
||||
$if registered
|
||||
#{iconOK}
|
||||
<td .table__td>#{examOccurrenceRoom}
|
||||
$if not examTimes
|
||||
<td .table__td>
|
||||
^{formatTimeRangeW SelFormatDateTime examOccurrenceStart examOccurrenceEnd}
|
||||
<td .table__td>
|
||||
$maybe desc <- examOccurrenceDescription
|
||||
#{desc}
|
||||
$forall (occurrence, registered) <- 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>
|
||||
$if occurrenceNamesShown
|
||||
<td .table__td #exam-occurrence__#{examOccurrenceName}>#{examOccurrenceName}
|
||||
<td .table__td>#{examOccurrenceRoom}
|
||||
$if not examTimes
|
||||
<td .table__td>
|
||||
^{formatTimeRangeW SelFormatDateTime examOccurrenceStart examOccurrenceEnd}
|
||||
$if showOccurrenceRegisterColumn
|
||||
<td .table__td>
|
||||
$maybe registerWdgt' <- registerWdgt
|
||||
^{registerWdgt'}
|
||||
$nothing
|
||||
$if registered
|
||||
#{iconOK}
|
||||
<td .table__td>
|
||||
$maybe desc <- examOccurrenceDescription
|
||||
#{desc}
|
||||
|
||||
$if gradingShown && not (null examParts)
|
||||
<section>
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
$newline never
|
||||
|
||||
<div .tooltip :isInlineTooltip:.tooltip__inline>
|
||||
<div .tooltip__handle .#{urgency}>
|
||||
<span .tooltip :isInlineTooltip:.tooltip__inline>
|
||||
<span .tooltip__handle .#{urgency}>
|
||||
<i .fas .fa-^{ic}>
|
||||
<div .tooltip__content>
|
||||
<span .tooltip__content>
|
||||
^{tooltip}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user