refactor!: remove applications and allocations
This commit is contained in:
Sarah Vaupel
parent
69de44893c
commit
66b4cf8542
@ -277,15 +277,6 @@ user-defaults:
|
||||
exam-office-get-synced: true
|
||||
exam-office-get-labels: true
|
||||
|
||||
# During central allocations lecturer-given ratings of applications (as
|
||||
# ExamGrades) are combined with a central priority.
|
||||
# This encodes the weight of the lecturer ratings on the same scale as the
|
||||
# centrally supplied priorities.
|
||||
allocation-grade-scale: 25
|
||||
# This encodes, as a proportion of the number of places, how many
|
||||
# ordinal places lecturer ratings may move students up or down when
|
||||
# central priorities are supplied as ordered list.
|
||||
allocation-grade-ordinal-proportion: 0.075
|
||||
|
||||
instance-id: "_env:INSTANCE_ID:instance"
|
||||
ribbon: "_env:RIBBON:"
|
||||
|
||||
@ -8,5 +8,4 @@ FAQCampusCantLogin: Ich kann mich mit meiner Fraport AG Kennung (Büko-Login) ni
|
||||
FAQCourseCorrectorsTutors: Wie kann ich Tutoren oder Korrektoren für meinen Kurs konfigurieren?
|
||||
FAQNotLecturerHowToCreateCourses: Wie kann ich einen neuen Kurs anlegen?
|
||||
FAQExamPoints: Warum kann ich bei meiner Klausur keine Punkte eintragen?
|
||||
FAQInvalidCredentialsAdAccountDisabled: Ich kann mich nicht anmelden und bekomme die Meldung „Benutzereintrag gesperrt“
|
||||
FAQAllocationNoPlaces: Ich habe über eine Zentralanmeldung keine Plätze/nicht die Plätze, die ich möchte, erhalten
|
||||
FAQInvalidCredentialsAdAccountDisabled: Ich kann mich nicht anmelden und bekomme die Meldung „Benutzereintrag gesperrt“
|
||||
@ -8,5 +8,4 @@ FAQCampusCantLogin: I can't log in using my Fraport AG credentials (Büko login)
|
||||
FAQCourseCorrectorsTutors: How can I add tutors or correctors to my course?
|
||||
FAQNotLecturerHowToCreateCourses: How can I create new courses?
|
||||
FAQExamPoints: Why can't I enter achievements for my exam as points?
|
||||
FAQInvalidCredentialsAdAccountDisabled: I can't log in and am instead given the message “Account disabled”
|
||||
FAQAllocationNoPlaces: I did not receive any places/the places I wanted from a central allocation
|
||||
FAQInvalidCredentialsAdAccountDisabled: I can't log in and am instead given the message “Account disabled”
|
||||
@ -31,10 +31,8 @@ UnauthorizedSystemPrinter: Sie sind nicht mit systemweitem Druck und Briefversan
|
||||
UnauthorizedSystemSap: Sie sind nicht mit der systemweitem SAP Schnittstellenverwaltung beauftragt.
|
||||
UnauthorizedExternalExamExamOffice: Es existieren keine Prüfungsergebnisse für Nutzer:innen, für die Sie mit der Prüfungsverwaltung beauftragt sind.
|
||||
UnauthorizedEvaluation: Sie sind nicht mit der Kursumfragenverwaltung beauftragt.
|
||||
UnauthorizedAllocationAdmin: Sie sind nicht mit der Administration von Zentralanmeldungen beauftragt.
|
||||
UnauthorizedSchoolLecturer: Sie sind nicht als Veranstalter:in für dieses Institut eingetragen.
|
||||
UnauthorizedLecturer: Sie sind nicht als Veranstalter:in für diese Veranstaltung eingetragen.
|
||||
UnauthorizedAllocationLecturer: Sie sind nicht als Veranstalter:in für eine Veranstaltung dieser Zentralanmeldung eingetragen.
|
||||
UnauthorizedCorrector: Sie sind nicht als Korrektor:in für diese Veranstaltung eingetragen.
|
||||
UnauthorizedSheetCorrector: Sie sind nicht als Korrektor:in für dieses Übungsblatt eingetragen.
|
||||
UnauthorizedExamCorrector: Sie sind nicht als Korrektor:in für diese Prüfung eingetragen.
|
||||
@ -42,19 +40,14 @@ UnauthorizedCorrectorAny: Sie sind nicht als Korrektor:in für eine Veranstaltun
|
||||
UnauthorizedRegistered: Sie sind nicht als Teilnehmer:in für diese Veranstaltung registriert.
|
||||
UnauthorizedRegisteredExam: Sie sind nicht als Teilnehmer:in für diese Prüfung registriert.
|
||||
UnauthorizedRegisteredAnyExam: Sie sind nicht als Teilnehmer:in für eine Prüfung registriert.
|
||||
UnauthorizedAllocationRegistered: Sie sind nicht als Teilnehmer:in für diese Zentralanmeldung registriert.
|
||||
UnauthorizedExamResult: Sie haben keine Ergebnisse in dieser Prüfung.
|
||||
UnauthorizedExamOccurrenceRegistration: Anmeldung zur Prüfung erfolgt nicht inkl. Raum/Termin.
|
||||
UnauthorizedExternalExamResult: Sie haben keine Ergebnisse in dieser Prüfung.
|
||||
UnauthorizedParticipant: Angegebener Benutzer/Angegebene Benutzerin ist nicht als Teilnehmer:in dieser Veranstaltung registriert.
|
||||
UnauthorizedParticipantSelf: Sie sind nicht Teilnehmer:in dieser Veranstaltung.
|
||||
UnauthorizedApplicant: Angegebener Benutzer/Angegebene Benutzerin hat sich nicht für diese Veranstaltung beworben.
|
||||
UnauthorizedApplicantSelf: Sie sind nicht Bewerber:in für diese Veranstaltung.
|
||||
UnauthorizedCourseTime: Dieser Kurs ist momentan nicht freigegeben.
|
||||
UnauthorizedCourseRegistrationTime: Dieser Kurs erlaubt momentan keine Anmeldungen.
|
||||
UnauthorizedAllocationRegisterTime: Diese Zentralanmeldung erlaubt momentan keine Bewerbungen.
|
||||
UnauthorizedSheetTime: Dieses Übungsblatt ist momentan nicht freigegeben.
|
||||
UnauthorizedApplicationTime: Diese Bewerbung ist momentan nicht freigegeben.
|
||||
UnauthorizedMaterialTime: Dieses Material ist momentan nicht freigegeben.
|
||||
UnauthorizedTutorialTime: Dieses Tutorium erlaubt momentan keine Anmeldungen.
|
||||
UnauthorizedCourseNewsTime: Diese Nachricht ist momentan nicht freigegeben.
|
||||
@ -85,9 +78,6 @@ UnauthorizedExternalExamLecturer: Sie sind nicht als Prüfer:in für diese exter
|
||||
UnauthorizedSubmissionSubmissionGroup: Sie sind nicht Mitglied in einer der registrierten Abgabegruppen, die an dieser Abgabe beteiligt sind
|
||||
UnauthorizedSheetSubmissionGroup: Sie sind nicht Mitglied in einer registrierten Abgabegruppe
|
||||
|
||||
UnauthorizedAllocatedCourseRegister: Direkte Anmeldungen zum Kurs sind aufgrund einer Zentralanmeldung aktuell nicht gestattet
|
||||
UnauthorizedAllocatedCourseDeregister: Abmeldungen vom Kurs sind aufgrund einer Zentralanmeldung aktuell nicht gestattet
|
||||
UnauthorizedAllocatedCourseDelete: Kurse, die an einer Zentralanmeldung teilnehmen, dürfen nicht gelöscht werden
|
||||
UnauthorizedWorkflowInitiate: Sie dürfen keinen neuen laufenden Workflow initiieren
|
||||
UnauthorizedWorkflowWrite: Sie dürfen aktuell keinen Zustandsübergang im Workflow auslösen
|
||||
UnauthorizedWorkflowRead: Der Workflow enthält aktuell keine Zustände oder Daten die Sie einsehen dürfen
|
||||
|
||||
@ -25,7 +25,6 @@ UnauthorizedSchoolAdmin: You are no administrator for this department.
|
||||
UnauthorizedAdminEscalation: You aren't an administrator for all departments for which this user is an administrator.
|
||||
UnauthorizedExamOffice: You are not part of an exam office.
|
||||
UnauthorizedEvaluation: You are not charged with course evaluation.
|
||||
UnauthorizedAllocationAdmin: You are not charged with the administration of central allocations.
|
||||
UnauthorizedExamExamOffice: You are not part of the appropriate exam office for any of the participants of this exam.
|
||||
UnauthorizedSchoolExamOffice: You are not part of an exam office for this school.
|
||||
UnauthorizedSystemExamOffice: You are not charged with system wide exam administration.
|
||||
@ -34,7 +33,6 @@ UnauthorizedSystemSap: You are not charged with system wide SAP administration.
|
||||
UnauthorizedExternalExamExamOffice: You are not part of the appropriate exam office for any of the participants of this exam.
|
||||
UnauthorizedSchoolLecturer: You are no lecturer for this department.
|
||||
UnauthorizedLecturer: You are no administrator for this course.
|
||||
UnauthorizedAllocationLecturer: You are no administrator for any of the courses of this central allocation.
|
||||
UnauthorizedCorrector: You are no sheet corrector for this course.
|
||||
UnauthorizedSheetCorrector: You are no corrector for this sheet.
|
||||
UnauthorizedExamCorrector: You are no corrector for this exam.
|
||||
@ -42,19 +40,14 @@ UnauthorizedCorrectorAny: You are no corrector for any course.
|
||||
UnauthorizedRegistered: You are no participant in this course.
|
||||
UnauthorizedRegisteredExam: You are not registered for this exam.
|
||||
UnauthorizedRegisteredAnyExam: You are not registered for an exam.
|
||||
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.
|
||||
UnauthorizedExternalExamResult: You have no results in this exam.
|
||||
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.
|
||||
UnauthorizedApplicantSelf: You are no applicant for this course.
|
||||
UnauthorizedCourseTime: This course is not currently available.
|
||||
UnauthorizedCourseRegistrationTime: This course does not currently allow enrollment.
|
||||
UnauthorizedAllocationRegisterTime: This central allocation does not currently allow applications.
|
||||
UnauthorizedSheetTime: This sheet is not currently available.
|
||||
UnauthorizedApplicationTime: This allocation is not currently available.
|
||||
UnauthorizedMaterialTime: This course material is not currently available.
|
||||
UnauthorizedTutorialTime: This tutorial does not currently allow registration.
|
||||
UnauthorizedCourseNewsTime: This news item is not currently available.
|
||||
@ -85,9 +78,6 @@ UnauthorizedExternalExamLecturer: You are not an associated person for this exte
|
||||
UnauthorizedSubmissionSubmissionGroup: You are not member in any of the submission groups for this submission
|
||||
UnauthorizedSheetSubmissionGroup: You are not member in any submission group
|
||||
|
||||
UnauthorizedAllocatedCourseRegister: Direct enrollment to this course is currently not allowed due to participation in a central allocation
|
||||
UnauthorizedAllocatedCourseDeregister: Deregistration from this course is currently not allowed due to participation in a central allocation
|
||||
UnauthorizedAllocatedCourseDelete: Courses that participate in a central allocation may not be deleted
|
||||
UnauthorizedWorkflowInitiate: You currently may not initiate a new running workflow
|
||||
UnauthorizedWorkflowWrite: You are currently not allowed to initiate any state transition within the workflow
|
||||
UnauthorizedWorkflowRead: The workflow currently contains no states or data you are permitted to view
|
||||
|
||||
@ -1,265 +0,0 @@
|
||||
# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
|
||||
#
|
||||
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
AllocationAcceptFormDoesNotMatchSession: Das Formular zum Akzeptieren der Vergabe wurde für ein anderes Vergabeergebnis erzeugt, als aktuell in Ihrer Session gespeichert ist.
|
||||
AllocationAccepted: Zentralvergabe gespeichert.
|
||||
HeadingAllocationAccept: Platzvergabe akzeptieren
|
||||
AllocationAddUserUserNotFound: E-Mail Adresse konnte keinem Benutzer zugeordnet werden
|
||||
AllocationAddUserUser: Benutzer:in
|
||||
AllocationAddUserUserPlaceholder: E-Mail
|
||||
AllocationAddUserTotalCoursesLessThanOne: Anzahl angefragter Plätze muss größer null sein
|
||||
AllocationAddUserTotalCourses: Angefragte Plätze
|
||||
AllocationAddUserSetPriority: Zentrale Dringlichkeit eintragen?
|
||||
AllocationAddUserPriority: Zentrale Dringlichkeit
|
||||
AllocationAddUserApplications: Bewerbungen/Bewertungen
|
||||
AllocationAddUserTitle termText@Text ssh'@SchoolShorthand allocation@AllocationName: #{termText} - #{ssh'} - #{allocation}: Bewerber:in hinzufügen
|
||||
AllocationAddUserShortTitle tid@TermId ssh@SchoolId ash@AllocationShorthand: #{tid}-#{ssh}-#{ash}: Bewerber:in hinzufügen
|
||||
AllocationAddUserUserAdded: Bewerber:in erfolgreich zur Zentralanmeldung hinzugefügt
|
||||
AllocationAddUserUserExists: Der/Die angegebene Benutzer/Benutzerin ist bereits ein/eine Bewerber/Bewerberin zur Zentralanmeldung
|
||||
AllocationEditUserUserEdited: Bewerber:in erfolgreich bearbeitet
|
||||
AllocationEditUserTitle termText@Text ssh@SchoolShorthand ash@AllocationShorthand userDisplayName@Text: #{termText} - #{ssh} - #{ash}, Bewerber:in bearbeiten: #{userDisplayName}
|
||||
AllocationEditUserShortTitle tid@TermId ssh@SchoolId ash@AllocationShorthand userDisplayName@Text !ident-ok: #{tid}-#{ssh}-#{ash}: #{userDisplayName}
|
||||
AllocationPriority: Priorität
|
||||
CourseAllocationCourseAcceptsSubstitutesUntil: Akzeptiert Nachrücker:innen bis
|
||||
CourseAllocationCourseAcceptsSubstitutesNever: Akzeptiert keine Nachrücker:innen
|
||||
CourseAllocationApplicationInstructionsApplication: Anweisungen zur Bewerbung
|
||||
CourseAllocationApplicationTemplateApplication: Bewerbungsvorlage(n)
|
||||
CourseApplication: Bewerbung
|
||||
AllocationCoursePriority i@Natural: #{i}. Wahl
|
||||
AllocationCourseNoApplication: Keine Bewerbung
|
||||
ApplicationPriority: Priorität
|
||||
ApplicationVeto !ident-ok: Veto
|
||||
ApplicationVetoTip: Bewerber:in mit Veto werden garantiert nicht dem Kurs zugeteilt
|
||||
ApplicationRatingPoints: Bewertung
|
||||
ApplicationRatingPointsTip: Bewerber:in mit 5.0 werden garantiert nicht dem Kurs zugeteilt
|
||||
ApplicationRatingComment: Kommentar
|
||||
ApplicationRatingCommentVisibleTip: Feedback an Bewerber:in
|
||||
ApplicationRatingCommentInvisibleTip: Dient zunächst nur als Notiz für Kursverwalter:innen
|
||||
ApplicationRatingSection: Bewertung
|
||||
ApplicationRatingSectionSelfTip: Sie verfügen über hinreichende Authorisierung um sowohl die Bewerbung als auch ihre Bewertung zu editieren.
|
||||
CourseApplicationExists: Sie haben sich bereits für diesen Kurs beworben
|
||||
CourseApplicationCreated csh@CourseShorthand: Erfolgreich zu #{csh} beworben
|
||||
CourseApplicationInvalidAction: Angegebene Aktion kann nicht durchgeführt werden
|
||||
CourseApplicationEdited csh@CourseShorthand: Bewerbung zu #{csh} erfolgreich angepasst
|
||||
CourseApplicationNotEdited csh@CourseShorthand: Bewerbung zu #{csh} hat sich nicht verändert
|
||||
CourseApplicationRated: Bewertung erfolgreich angepasst
|
||||
CourseApplicationRatingDeleted: Bewertung erfolgreich entfernt
|
||||
CourseApplicationDeleted csh@CourseShorthand: Bewerbung zu #{csh} erfolgreich zurückgezogen
|
||||
AllocationUsersMissingPriorities: Teilnehmer:innen ohne zentrale Dringlichkeit
|
||||
AllocationUsersMissingPrioritiesTip: Es muss sichergestellt sein, dass keine Teilnehmer:innen unberechtigt aus der Zentralvergabe ausgeschlossen werden, indem ihnen keine zentrale Dringlichkeit zugewiesen wurde.
|
||||
AllocationUsersMissingPrioritiesOk: Es wurde sichergestellt, dass es für jeden der genannten Benutzer:innen einen zulässigen Grund gibt, warum dieser nicht an der Zentralanmeldung teilnehmen sollte.
|
||||
AllocationUsersMissingPrioritiesNotOk: Zentralvergabe kann nicht erfolgen, solange nicht allen Teilnehmer:innen, die nicht explizit von der Vergabe ausgeschlossen wurden („Teilnehmer:in ohne zentrale Dringlichkeit”), eine zentrale Dringlichkeit zugewiesen wurde!
|
||||
AllocationRestrictCourses: Kurse einschränken
|
||||
AllocationRestrictCoursesTip: Sollen nur Plätze für eine Teilmenge von Kursen zugewiesen werden? So können u.A. Nachrücker:innen verteilt werden. Diese Funktionalität sollte nur verwendet werden, wenn manche Kurse aus zulässigen Gründen ausgeschlossen werden müssen; z.B. weil ein Seminar bereits ein Treffen zur Organisation hatte und nun keine weiteren Teilnehmer:innen mehr akzeptieren kann.
|
||||
AllocationRestrictCoursesSelection: Kurse
|
||||
AllocationRestrictCoursesSelectionTip: Teilnehmer:innen werden nur auf die Kurse verteilt, die hier angegeben werden.
|
||||
AllocationOnlyCompute: Durch Senden dieses Formulars wird zunächst nur eine mögliche Zentralvergabe berechnet und zur Kontrolle temporär gespeichert. Es werden keine Änderungen am Stand der Datenbank vorgenommen oder Benachrichtigungen verschickt.
|
||||
AllocationComputed: Eine mögliche Zentralvergabe wurde berechnet und in Ihrer Session gespeichert. Es wurden noch keine Änderungen vorgenommen!
|
||||
HeadingAllocationCompute: Platzvergabe berechnen
|
||||
HeadingAllocationInfo: Hinweise zum Ablauf einer Zentralanmeldung
|
||||
AllocationAvailableCourses: Kurse
|
||||
AllocationAppliedCourses: Bewerbungen
|
||||
AllocationListTitle: Zentralanmeldungen
|
||||
AllocationMissingPrioritiesIgnored: Bewerber:innen, für die keine zentrale Priorität angegeben wird, werden bei der Vergabe ignoriert!
|
||||
AllocationPriorities: Zentrale Dringlichkeiten
|
||||
AllocationPrioritiesTitle tid@TermId ssh@SchoolId ash@AllocationShorthand: #{tid}-#{ssh}-#{ash}: Zentrale Dringlichkeiten
|
||||
AllocationPrioritiesFile: CSV-Datei
|
||||
AllocationPrioritiesSunk num@Int64: Zentrale Prioritäten für #{num} Bewerber erfolgreich hinterlegt
|
||||
AllocationPrioritiesMissing num@Int64: Für #{num} #{pluralDE num "Bewerber:in" "Bewerber:innen"} ist keine zentrale Priorität hinterlegt, da in der hochgeladenen CSV-Datei die #{pluralDE num "entsprechende Matrikelnummer" "entsprechenden Matrikelnummern"} nicht gefunden #{pluralDE num "wurde" "wurden"}
|
||||
AllocationPrioritiesMode: Modus
|
||||
AllocationTotalCoursesNegative: Gewünschte Kursanzahl muss größer null sein
|
||||
AllocationTotalCourses: Gewünschte Anzahl von Kursen
|
||||
AllocationTotalCoursesTip: Sie werden im Laufe dieser Zentralanmeldung maximal so vielen Kursen zugeteilt, wie Sie hier angeben
|
||||
AllocationRegistered: Teilnahme an der Zentralanmeldung erfolgreich registriert
|
||||
AllocationRegistrationEdited: Einstellungen zur Teilnahme an der Zentralanmeldung erfolgreich angepasst
|
||||
AllocationTitle termText@Text ssh'@SchoolShorthand allocation@AllocationName !ident-ok: #{termText} - #{ssh'}: #{allocation}
|
||||
AllocationShortTitle termText@Text ssh'@SchoolShorthand ash@AllocationShorthand !ident-ok: #{termText} - #{ssh'} - #{ash}
|
||||
AllocationNotificationNewCourse: Benachrichtigung bei neuen Kursen
|
||||
AllocationNotificationNewCourseTip: Wollen Sie per E-Mail benachrichtigt werden, wenn für diese Zentralanmeldung ein neuer Kurs eingetragen wird? Dies überschreibt die systemweite Einstellung in "Anpassen".
|
||||
AllocationNotificationNewCourseSuccessForceOn: Sie werden benachrichtigt, wenn ein neuer Kurs eingetragen wird
|
||||
AllocationNotificationNewCourseSuccessForceOff: Sie werden nicht benachrichtigt, wenn ein neuer Kurs eingetragen wird
|
||||
AllocationNotificationNewCourseCurrentlyOff: Aktuell würden Sie keine Benachrichtigung erhalten.
|
||||
AllocationNotificationNewCourseCurrentlyOn: Aktuell würden Sie benachrichtigt werden.
|
||||
CsvColumnAllocationUserSurname: Nachname(n) des/der Bewerbers/Bewerberin
|
||||
CsvColumnAllocationUserFirstName: Vorname(n) des/der Bewerbers/Bewerberin
|
||||
CsvColumnAllocationUserName: Voller Name des/der Bewerbers/Bewerberin
|
||||
CsvColumnAllocationUserMatriculation: Matrikelnummer des/der Bewerbers/Bewerberin
|
||||
CsvColumnAllocationUserStudyFeatures: Studiendaten
|
||||
CsvColumnAllocationUserRequested: Maximale Anzahl von Plätzen, die der Bewerber bereit ist, zu akzeptieren
|
||||
CsvColumnAllocationUserApplied: Anzahl von Bewerbungen, die der/die Bewerber/Bewerberin eingereicht hat
|
||||
CsvColumnAllocationUserVetos: Anzahl von Bewerbungen, die von Kursverwalter:innen ein Veto oder eine Note erhalten haben, die äquivalent ist zu "Nicht Bestanden" (5.0)
|
||||
CsvColumnAllocationUserAssigned: Anzahl von Plätzen, die der/die Bewerber/Bewerberin durch diese Zentralanmeldung bereits erhalten hat
|
||||
CsvColumnAllocationUserNewAssigned: Anzahl von Plätzen, die der/die Bewerber/Bewerberin, nach Akzeptieren der berechneten Verteilung, zusätzlich erhalten würde
|
||||
CsvColumnAllocationUserPriority: Zentrale Dringlichkeit des/der Bewerbers/Bewerberin; entweder einzelne Zahl für Sortierungsbasierte Dringlichkeiten (höhere Dringlichkeit entspricht größerer Zahl) oder Komma-separierte Liste von numerischen Dringlichkeiten in eckigen Klammern (z.B. [1, 2, 3])
|
||||
AllocationUsersCsvName tid@TermId ssh@SchoolId ash@AllocationShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase ash}-bewerber:in
|
||||
AllocationUserNewMatches: Neue Zuteilungen
|
||||
AllocationUsers: Bewerber:innen
|
||||
AllocationUsersTitle tid@TermId ssh@SchoolId ash@AllocationShorthand: #{tid}-#{ssh}-#{ash}: Bewerber:innen
|
||||
|
||||
#templates allocation/show/course
|
||||
AllocationNoApplication: Keine Bewerbung
|
||||
CourseAllocationCourseParticipants: Teilnehmer:innen
|
||||
CourseMembersCount n@Int !ident-ok: #{n}
|
||||
CourseMembersCountLimited n@Int max@Int !ident-ok: #{n}/#{max}
|
||||
CourseAllocationCourseRatings ratings@Word64 vetos@Word64: #{ratings} #{pluralDE ratings "Bewertung" "Bewertungen"} (#{vetos} #{pluralDE vetos "Veto" "Vetos"})
|
||||
|
||||
#templates allocation/accept
|
||||
ComputedAllocation: Berechnete Vergabe
|
||||
AllocationUsersCount: Teilnehmer:innen
|
||||
AllocationCoursesCount: Kurse
|
||||
AllocationRequestedPlaces: Angefragte Plätze
|
||||
AllocationOfferedPlaces: Angebotene Plätze
|
||||
AllocationUnmatchedUsers: Teilnehmer:innen ohne zugeteilte Plätze
|
||||
AllocationUnmatchedCourses: Kurse ohne zugeteilte Teilnehmer:innen
|
||||
AllocationTime: Zeitpunkt der Vergabe
|
||||
AllocationCourseEligible: Berücksichtigt
|
||||
AllocationMatchedUsers: Neu zugeteilt
|
||||
|
||||
#templates allocation/show
|
||||
AllocationSchool: Institut
|
||||
AllocationSemester !ident-ok: Semester
|
||||
AllocationDescription: Beschreibung
|
||||
AllocationStaffDescription: Beschreibung für Dozierende
|
||||
AllocationStaffRegisterFrom: Eintragung der Kurse ab
|
||||
AllocationStaffRegisterTo: Eintragung der Kurse bis
|
||||
AllocationStaffRegister: Eintragung der Kurse
|
||||
AllocationStaffAllocationFrom: Bewertung der Bewerbungen ab
|
||||
AllocationStaffAllocationTo: Bewertung der Bewerbungen bis
|
||||
AllocationStaffAllocation: Bewertung der Bewerbungen
|
||||
AllocationRegisterFrom: Bewerbung ab
|
||||
AllocationRegister: Bewerbung
|
||||
AllocationRegisterClosed: Die Zentralanmeldung ist aktuell geschlossen.
|
||||
AllocationRegisterOpensIn difftime@Text: Die Zentralanmeldung öffnet voraussichtlich in #{difftime}
|
||||
AllocationRegisterByStaff: An- und Abmeldung durch Kursverwalter:innen
|
||||
AllocationRegisterByStaffFrom: An- und Abmeldung durch Kursverwalter:innen ab
|
||||
AllocationRegisterByStaffTo: An- und Abmeldung durch Kursverwalter:innen bis
|
||||
AllocationRegisterByStaffTip: In diesem Zeitraum können Kursverwalter:innen Teilnehmer:innen zu und von ihren Kursen an- und abmelden.
|
||||
AllocationRegisterByStaffFromTip: Ab diesem Zeitpunkt können Kursverwalter:innen Teilnehmer:innen zu und von ihren Kursen an- und abmelden.
|
||||
AllocationRegisterByCourse: Direkte An- und Abmeldung
|
||||
AllocationRegisterByCourseFrom: Direkte An- und Abmeldung ab
|
||||
AllocationRegisterByCourseFromTip: Frühestens ab diesem Zeitpunkt ist die eigentständige An- und Abmeldung zu und von den Kursen, die an der Zentralanmeldung teilnehmen, möglich. Kontrolle über die genauen Fristen haben die Kursverwalter:innen.
|
||||
AllocationRegisterTo: Anmeldungen bis
|
||||
AllocationNextSubstitutesDeadline: Nächster Kurs akzeptiert Nachrücker:innen bis
|
||||
AllocationNextSubstitutesDeadlineNever: Keine Kurse akzeptieren mehr Nachrücker:innen
|
||||
AllocationFreeCapacity: Freie Plätze
|
||||
AllocationOverrideDeregister: Abmeldung von den Kursen nur bis
|
||||
AllocationParticipation: Teilnahme an der Zentralanmeldung
|
||||
AllocationParticipationLoginFirst: Um an der Zentralanmeldung teilzunehmen, loggen Sie sich bitte zunächst ein.
|
||||
AllocationNotificationLoginFirst: Um Ihre Benachrichtigungseinstellungen zu ändern, loggen Sie sich bitte zunächst ein.
|
||||
AllocationCourses: Kurse dieser Zentralanmeldung
|
||||
AllocationPriorityTip: Kurse, denen Sie eine höhere Priorität zuteilen, werden bei der Platzvergabe präferiert.
|
||||
AllocationPriorityRelative: Die absoluten Prioritäts-Werte sind bedeutungslos, es wird nur jeweils betrachtet ob ein Kurs höhere Priorität hat als ein anderer.
|
||||
ApplicationEditTip: Während des Bewerbungszeitraums können eigene Bewerbungen beliebig angepasst und auch wieder zurückgezogen werden.
|
||||
AllocationNumCoursesAvailableApplied available@Int applied@Int: Sie haben sich bisher für #{applied}/#{available} #{pluralDE applied "Kurs" "Kursen"} beworben
|
||||
|
||||
AllocationCourseRestrictionDontRestrict: Nicht einschränken
|
||||
AllocationCourseRestrictionSubstitutes: Kurse, die aktuell Nachrücker akzeptieren
|
||||
AllocationCourseRestrictionCustom: Benutzerdefiniert
|
||||
|
||||
AllocationName !ident-ok: Name
|
||||
Allocation: Zentralanmeldung
|
||||
AllocationActive: Aktiv
|
||||
AllocationUsersApplied: Bewerbungen
|
||||
AllocationUsersAssigned: Zuweisungen
|
||||
AllocationUsersVetoed !ident-ok: Vetos
|
||||
AllocationUsersRequested: Angefragte Plätze
|
||||
AllocationUsersPriority: Zentrale Dringlichkeit
|
||||
|
||||
AllocationPriorityNumericValues: Numerische Werte
|
||||
AllocationPriorityNumericValuesTip: Komma-separierte ganze Zahlen
|
||||
AllocationPriorityNumericNoValues: Es wurden keine numerischen Werte angegeben
|
||||
AllocationPriorityNumericNoParse val@Text: Ganze Zahl konnte nicht geparst werden: „#{val}“
|
||||
AllocationPriorityOrdinalValueNegative: Sortier-Index darf nicht negativ sein
|
||||
AllocationPriorityOrdinalValue: Sortier-Index
|
||||
AllocationPriorityOrdinalValueTip: Null entspricht dem ersten Eintrag der Liste, höhere Indizes entsprechen später in der sortierten Liste vorkommenden Bewerbern und damit einer höheren Dringlichkeit
|
||||
AllocationPriorityNumeric': Numerisch
|
||||
AllocationPriorityOrdinal': Nach Sortierung
|
||||
AllocationPrioritiesNumeric: Numerische Dringlichkeiten
|
||||
AllocationPrioritiesOrdinal: Dringlichkeiten durch Sortierung
|
||||
AllocationUsersCsvSheetName tid@TermId ssh@SchoolId ash@AllocationShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase ash} Bewerber
|
||||
AllocationApplication: Bewerbung
|
||||
AllocationProcess: Platzvergabe
|
||||
AllocationSubstitutesProcess: Platzvergabe an Nachrücker:innen
|
||||
|
||||
AllocationFormTerm: Semester
|
||||
AllocationFormSchool: Institut
|
||||
AllocationFormShorthand: Kürzel
|
||||
AllocationFormName !ident-ok: Name
|
||||
AllocationFormLegacyShorthands: Alte Kürzel
|
||||
AllocationFormLegacyShorthandsTip: Zentralanmeldungen werden gelegentlich mit vorherigen Versionen in Bezug gesetzt (z.B. um Kapazität/Auslastung zu vergleichen). Dies geschieht anhand des Kürzels, bzw. anhand der hier angegebenen alten Kürzel. (Komma-separierte Liste)
|
||||
AllocationFormDescriptions: Beschreibungen
|
||||
AllocationFormDescription: Beschreibung
|
||||
AllocationFormDescriptionTip: Wird allen Benutzern auf der Seite der Zentralanmeldung angezeigt
|
||||
AllocationFormStaffDescription: Beschreibung für Dozierende
|
||||
AllocationFormStaffDescriptionTip: Wird nur (potentiellen) Dozierenden angezeigt; sowohl beim Anlegen eines Kurses, wie auch auf der Seite der Zentralanmeldung
|
||||
AllocationFormDeadlines: Fristen
|
||||
AllocationFormStaffRegisterFrom: Eintragung der Kurse ab
|
||||
AllocationFormStaffRegisterFromTip: Ab diesem Zeitpunkt können Kursverwalter:innen ihre Kurse selbstständig zur Zentralanmeldung eintragen. Falls kein Zeitpunkt angegeben wird, ist dies nie gestattet.
|
||||
AllocationFormStaffRegisterTo: Eintragung der Kurse bis
|
||||
AllocationFormStaffRegisterToTip: Falls kein Zeitpunkt angegeben wird, ist die Eintragung zunächst für immer möglich.
|
||||
AllocationFormStaffAllocationFrom: Bewertung der Bewerbungen ab
|
||||
AllocationFormStaffAllocationFromTip: Ab diesem Zeitpunkt dürfen Kursverwalter:innen Bewerbungen zu ihren Kursen bewerten. Falls kein Zeitpunkt angegeben wird, ist dies nie gestattet.
|
||||
AllocationFormStaffAllocationTo: Bewertung der Bewerbungen bis
|
||||
AllocationFormStaffAllocationToTip: Falls kein Zeitpunkt angegeben wird, ist die Bewertung zunächst für immer möglich.
|
||||
AllocationFormRegisterFrom: Bewerbung ab
|
||||
AllocationFormRegisterFromTip: Ab diesem Zeitpunkt dürfen alle Benutzer Bewerbungen zu den teilnehmenden Kursen hinterlegen. Falls kein Zeitpunkt angegeben wird, ist dies nie gestattet.
|
||||
AllocationFormRegisterTo: Bewerbung bis
|
||||
AllocationFormRegisterToTip: Falls kein Zeitpunkt angegeben wird, ist Bewerbung zunächst für immer möglich.
|
||||
AllocationFormRegisterByStaffFrom: An- und Abmeldung durch Kursverwalter:innen ab
|
||||
AllocationFormRegisterByStaffFromTip: Ab diesem Zeitpunkt dürfen Kursverwalter:innen Studierende direkt zu ihren Kursen anmelden. Falls kein Zeitpunkt angegeben wird, ist dies für an der Zentralanmeldung teilnehmende Kurse nie gestattet.
|
||||
AllocationFormRegisterByStaffTo: An- und Abmeldung durch Kursverwalter:innen bis
|
||||
AllocationFormRegisterByStaffToTip: Falls kein Zeitpunkt angegeben wird, ist An- und Abmeldung zunächst für immer möglich.
|
||||
AllocationFormRegisterByCourse: An- und Abmeldung nach Kursregeln ab
|
||||
AllocationFormRegisterByCourseTip: Ab diesem Zeitpunkt folgt selbstständige An- und Abmeldung zu bzw. von den teilnehmenden Kursen wieder den Regeln des jeweiligen Kurses. Falls kein Zeitpunkt angegeben wird, ist direkte An- und Abmeldung nie gestattet.
|
||||
AllocationFormOverrideDeregister: Direkte Abmeldung frühestens ab
|
||||
AllocationFormOverrideDeregisterTip: Bis zu diesem Zeitpunkt dürfen Teilnehmende sich nicht von teilnehmenden Kursen abmelden, selbst wenn dies nach Kursregeln gestattet wäre. Falls kein Zeitpunkt angegeben wird, ist Abmeldung nach Kursregeln gestattet (bzw. ab „_{MsgAllocationFormRegisterByCourse}“).
|
||||
|
||||
AllocationFormStaffRegisterToMustBeAfterFrom: „_{MsgAllocationFormStaffRegisterTo}“ muss nach „_{MsgAllocationFormStaffRegisterFrom}“ liegen.
|
||||
AllocationFormStaffAllocationToMustBeAfterFrom: „_{MsgAllocationFormStaffAllocationTo}“ muss nach „_{MsgAllocationFormStaffAllocationFrom}“ liegen.
|
||||
AllocationFormRegisterToMustBeAfterFrom: „_{MsgAllocationFormRegisterTo}“ muss nach „_{MsgAllocationFormRegisterFrom}“ liegen.
|
||||
AllocationFormRegisterByStaffToMustBeAfterFrom: „_{MsgAllocationFormRegisterByStaffTo}“ muss nach „_{MsgAllocationFormRegisterByStaffFrom}“ liegen.
|
||||
AllocationFormStaffRegisterFromMustBeBeforeStaffAllocationFrom: „_{MsgAllocationFormStaffRegisterFrom}“ muss vor „_{MsgAllocationFormStaffAllocationFrom}“ liegen.
|
||||
AllocationFormStaffRegisterToMustBeBeforeStaffAllocationTo: „_{MsgAllocationFormStaffRegisterTo}“ muss vor „_{MsgAllocationFormStaffAllocationTo}“ liegen.
|
||||
AllocationFormStaffRegisterFromMustBeBeforeRegisterFrom: „_{MsgAllocationFormStaffRegisterFrom}“ muss vor „_{MsgAllocationFormRegisterFrom}“ liegen.
|
||||
AllocationFormStaffRegisterToMustBeBeforeRegisterTo: „_{MsgAllocationFormStaffRegisterTo}“ muss vor „_{MsgAllocationFormRegisterTo}“ liegen.
|
||||
AllocationFormStaffAllocationToShouldBeBeforeRegisterByStaffFrom: „_{MsgAllocationFormStaffAllocationTo}“ sollte vor „_{MsgAllocationFormRegisterByStaffFrom}“ liegen.
|
||||
AllocationFormStaffAllocationToShouldBeBeforeRegisterByCourse: „_{MsgAllocationFormStaffAllocationTo}“ sollte vor „_{MsgAllocationFormRegisterByCourse}“ liegen.
|
||||
AllocationFormStaffAllocationToShouldBeAfterRegisterTo: „_{MsgAllocationFormStaffAllocationTo}“ sollte nach „_{MsgAllocationFormRegisterTo}“ liegen.
|
||||
AllocationFormRegisterToShouldBeBeforeRegisterByStaffFrom: „_{MsgAllocationFormRegisterTo}“ sollte vor „_{MsgAllocationFormRegisterByStaffFrom}“ liegen.
|
||||
AllocationFormRegisterToShouldBeBeforeRegisterByCourse: „_{MsgAllocationFormRegisterTo}“ sollte vor „_{MsgAllocationFormRegisterByCourse}“ liegen.
|
||||
AllocationFormRegisterByStaffFromShouldBeBeforeRegisterByCourse: „_{MsgAllocationFormRegisterByStaffFrom}“ sollte vor „_{MsgAllocationFormRegisterByCourse}“ liegen.
|
||||
|
||||
AllocationNewSuccess: Zentralanmeldung erfolgreich angelegt
|
||||
AllocationNewAlreadyExists: Eine Zentralanmeldung mit diesem Namen/Kürzel existiert bereits für diese Kombination aus Semester und Institut.
|
||||
|
||||
TitleAllocationNew: Neue Zentralanmeldung anlegen
|
||||
|
||||
TitleAllocationEdit tid@TermId ssh@SchoolId ash@AllocationShorthand: #{toPathPiece tid}-#{ssh}-#{ash}: Zentralanmeldung bearbeiten
|
||||
HeadingAllocationEdit tid@TermId ssh@SchoolId aname@AllocationName: Zentralanmeldung bearbeiten: _{ShortTermIdentifier (unTermKey tid)}, #{ssh}, #{aname}
|
||||
|
||||
AllocationEditSuccess: Zentralanmeldung erfolgreich bearbeitet
|
||||
AllocationEditAlreadyExists: Eine andere Zentralanmeldung mit diesem Namen/Kürzel existiert bereits für diese Kombination aus Semester und Institut.
|
||||
|
||||
TitleAllocationMatchings tid@TermId ssh@SchoolId ash@AllocationShorthand: #{toPathPiece tid}-#{ssh}-#{ash}: Verteilungen
|
||||
HeadingAllocationMatchings tid@TermId ssh@SchoolId aname@AllocationName: Verteilungen: _{ShortTermIdentifier (unTermKey tid)}, #{ssh}, #{aname}
|
||||
AllocationMatchingsNone: Noch keine Verteilungen
|
||||
AllocationMatchingsLog: Protokoll
|
||||
AllocationMatchingsTime: Zeitpunkt
|
||||
AllocationMatchingsFingerprint: Prüfsumme
|
||||
|
||||
AllocationMatchingLogFileName tid@TermId ssh@SchoolId ash@AllocationShorthand cID@CryptoUUIDAllocationMatching: za-verteilung.#{toPathPiece tid}-#{ssh}-#{ash}.#{toPathPiece cID}.log
|
||||
|
||||
AllocationUserDeleteQuestion: Wollen Sie den/die unten aufgeführten Benutzer:in wirklich aus der Zentralanmeldung entfernen?
|
||||
AllocationUserDeleted: Benutzer:in erfolgreich entfernt
|
||||
AllocationApplicationsCount n@Word64: #{n} #{pluralDE n "Bewerbung" "Bewerbungen"}
|
||||
AllocationAllocationsCount n@Word64: #{n} #{pluralDE n "Zuweisung" "Zuweisungen"}
|
||||
AllocationCourseHasRatings ratings@Word64 vetos@Word64: Dieser Kurs hat bereits #{ratings} #{pluralDE ratings "Bewertung" "Bewertungen"} (#{vetos} #{pluralDE vetos "Veto" "Vetos"})
|
||||
|
||||
AllocationCourseParticipantFormCourse: Kurs
|
||||
AllocationCourseParticipantFormIsRegistered: Registriert?
|
||||
AllocationCourseParticipantFormIsSelfInflicted: Selbstverschuldet abgemeldet (Grund)?
|
||||
AllocationCourseParticipantFormDefaultReason: Kein Grund
|
||||
|
||||
AllocationUserCourseParticipantFormTitle: Anmeldungen
|
||||
AllocationUserAllocationUserFormTitle: Teilnahme an der Zentralanmeldung
|
||||
@ -1,264 +0,0 @@
|
||||
# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
|
||||
#
|
||||
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
AllocationAcceptFormDoesNotMatchSession: The form to accept the computed allocation was generated for a different result than the one, that is currently saved in your session.
|
||||
AllocationAccepted: Successfully saved allocation
|
||||
HeadingAllocationAccept: Accept allocation
|
||||
AllocationAddUserUserNotFound: Email could not be resolved to an user
|
||||
AllocationAddUserUser: User
|
||||
AllocationAddUserUserPlaceholder: Email
|
||||
AllocationAddUserTotalCoursesLessThanOne: Number of requested courses needs to be greater than zero
|
||||
AllocationAddUserTotalCourses: Requested courses
|
||||
AllocationAddUserSetPriority: Set central priority?
|
||||
AllocationAddUserPriority: Central priority
|
||||
AllocationAddUserApplications: Applications/Ratings
|
||||
AllocationAddUserTitle termText ssh' allocation: #{termText} - #{ssh'} - #{allocation}: Add applicant
|
||||
AllocationAddUserShortTitle tid@TermId ssh@SchoolId ash@AllocationShorthand: #{tid}-#{ssh}-#{ash}: Add applicant
|
||||
AllocationAddUserUserAdded: Successfully added applicant to central allocation
|
||||
AllocationAddUserUserExists: The specified user is already an applicant for the central allocation
|
||||
AllocationEditUserUserEdited: Successfully edited applicant
|
||||
AllocationEditUserTitle termText ssh ash userDisplayName: #{termText} - #{ssh} - #{ash}, Edit applicant: #{userDisplayName}
|
||||
AllocationEditUserShortTitle tid ssh ash userDisplayName !ident-ok: #{tid}-#{ssh}-#{ash}: #{userDisplayName}
|
||||
AllocationPriority: Priority
|
||||
CourseAllocationCourseAcceptsSubstitutesUntil: Accepts substitutes until
|
||||
CourseAllocationCourseAcceptsSubstitutesNever: Does not accept substitutes
|
||||
CourseAllocationApplicationInstructionsApplication: Instructions for application
|
||||
CourseAllocationApplicationTemplateApplication: Application template(s)
|
||||
CourseApplication: Application
|
||||
AllocationCoursePriority i: #{ordinalEN i}
|
||||
AllocationCourseNoApplication: No
|
||||
ApplicationPriority: Priority
|
||||
ApplicationVeto: Veto
|
||||
ApplicationVetoTip: Vetoed applicants will not be assigned to the course
|
||||
ApplicationRatingPoints: Grading
|
||||
ApplicationRatingPointsTip: Applicants graded 5.0 will not be assigned to the course
|
||||
ApplicationRatingComment: Comment
|
||||
ApplicationRatingCommentVisibleTip: Feedback for the applicant
|
||||
ApplicationRatingCommentInvisibleTip: Currently only a note for course administrators
|
||||
ApplicationRatingSection: Grading
|
||||
ApplicationRatingSectionSelfTip: You are authorised to edit the application as well as it's grading.
|
||||
CourseApplicationExists: You already applied for this course
|
||||
CourseApplicationCreated csh: Successfully applied for #{csh}
|
||||
CourseApplicationInvalidAction: Invalid action
|
||||
CourseApplicationEdited csh: Successfully changed application for #{csh}
|
||||
CourseApplicationNotEdited csh: Application for #{csh} not changed
|
||||
CourseApplicationRated: Successfully edited rating
|
||||
CourseApplicationRatingDeleted: Successfully deleted rating
|
||||
CourseApplicationDeleted csh: Successfully withdrew application for #{csh}
|
||||
AllocationUsersMissingPriorities: Participants without central priority
|
||||
AllocationUsersMissingPrioritiesTip: Care must be taken, that no participant is excluded from the allocation by not having been assigned a central priority.
|
||||
AllocationUsersMissingPrioritiesOk: It was ensured, that all participants mentioned above, are excluded from the allocation on valid grounds.
|
||||
AllocationUsersMissingPrioritiesNotOk: Central allocation cannot occur until all participants, that were not excluded explicitly (“Participants without central priority”), have been assigned a central priority!
|
||||
AllocationRestrictCourses: Restrict courses
|
||||
AllocationRestrictCoursesTip: Should places be assigned only in a subset of courses? This functionality can be used to make alternate placements in the case that some participants withdraw from their assigned courses. This functionality should only be used to exclude courses on valid grounds. E.g. if a seminar already had a planning meeting and is thus unable to accept new participants.
|
||||
AllocationRestrictCoursesSelection: Courses
|
||||
AllocationRestrictCoursesSelectionTip: Participants will only be assigned to courses listed here.
|
||||
AllocationOnlyCompute: By sending this form a possible allocation will be computed and saved temporarily. You can then check that the computed allocation is as expected. No changes will yet be made to the state of the database and no notifications will be sent.
|
||||
AllocationComputed: A possible allocation has been computed and stored in your session. No changes have yet been made!
|
||||
HeadingAllocationCompute: Compute allocation
|
||||
HeadingAllocationInfo: Information regarding central allocations
|
||||
AllocationAvailableCourses: Courses
|
||||
AllocationAppliedCourses: Applications
|
||||
AllocationListTitle: Central allocations
|
||||
AllocationMissingPrioritiesIgnored: Applicants for whom no central priority has been registered will be ignored during assignment!
|
||||
AllocationPriorities: Central priorities
|
||||
AllocationPrioritiesTitle tid ssh ash: #{tid}-#{ssh}-#{ash}: Central priorities
|
||||
AllocationPrioritiesFile: CSV file
|
||||
AllocationPrioritiesSunk num: Successfully registered central priorities for #{num} #{pluralEN num "applicant" "applicants"}
|
||||
AllocationPrioritiesMissing num: Could not register central priorities for #{num} #{pluralEN num "applicant" "applicants"} because their matriculation was not found in the uploaded CSV file
|
||||
AllocationPrioritiesMode: Mode
|
||||
AllocationTotalCoursesNegative: Requested number of placements must be greater than zero
|
||||
AllocationTotalCourses: Requested number of placements
|
||||
AllocationTotalCoursesTip: During the allocation process you will be placed in at most as many courses as specified
|
||||
AllocationRegistered: Successfully registered participation in this central allocation
|
||||
AllocationRegistrationEdited: Successfully edited registration for this central allocation
|
||||
AllocationTitle termText ssh' allocation: #{termText} - #{ssh'}: #{allocation}
|
||||
AllocationShortTitle termText ssh' ash: #{termText} - #{ssh'} - #{ash}
|
||||
AllocationNotificationNewCourse: Notifications for new courses
|
||||
AllocationNotificationNewCourseTip: Do you want to be notified if a new course is added to this central allocation? This overrides the system wide setting under “Settings”.
|
||||
AllocationNotificationNewCourseSuccessForceOn: You will be notified if a new course is added
|
||||
AllocationNotificationNewCourseSuccessForceOff: You will not be notified if a new course is added
|
||||
AllocationNotificationNewCourseCurrentlyOff: Currently you would not receive a notification.
|
||||
AllocationNotificationNewCourseCurrentlyOn: Currently you would be notified.
|
||||
CsvColumnAllocationUserSurname: Applicant's surname(s)
|
||||
CsvColumnAllocationUserFirstName: Applicants's first name(s)
|
||||
CsvColumnAllocationUserName: Applicant's full name
|
||||
CsvColumnAllocationUserMatriculation: Applicant's matriculation
|
||||
CsvColumnAllocationUserStudyFeatures: Features of study
|
||||
CsvColumnAllocationUserRequested: Maximum number of placements the applicant is prepared to accept
|
||||
CsvColumnAllocationUserApplied: Number of applications the applicant has provided
|
||||
CsvColumnAllocationUserVetos: Number of applications that have received a veto from a course administrator or have been rated with a grade that is equivalent to "failed" (5.0)
|
||||
CsvColumnAllocationUserAssigned: Number of assignments the applicant has already received
|
||||
CsvColumnAllocationUserNewAssigned: Number of assignments the applicant would receive, if the calculated matching is accepted
|
||||
CsvColumnAllocationUserPriority: Central priority of this applicant; either a number based on the applicants position in the list sorted by priority (higher numbers mean a higher priority) or a comma-separated list of numerical priorities in square brackets (e.g. [1, 2, 3])
|
||||
AllocationUsersCsvName tid ssh ash: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase ash}-applicants
|
||||
AllocationUserNewMatches: New allocations
|
||||
AllocationUsers: Applicants
|
||||
AllocationUsersTitle tid ssh ash: #{tid}-#{ssh}-#{ash}: Applicants
|
||||
|
||||
#templates allocation/show/course
|
||||
AllocationNoApplication: No application
|
||||
CourseAllocationCourseParticipants: Participants
|
||||
CourseMembersCount n: #{n}
|
||||
CourseMembersCountLimited n max: #{n}/#{max}
|
||||
CourseAllocationCourseRatings ratings vetos: #{ratings} #{pluralENs ratings "rating"} (#{vetos} #{pluralENs vetos "veto"})
|
||||
|
||||
#templates allocation/accept
|
||||
ComputedAllocation: Computed allocation
|
||||
AllocationUsersCount: Participants
|
||||
AllocationCoursesCount: Courses
|
||||
AllocationRequestedPlaces: Requested places
|
||||
AllocationOfferedPlaces: Offered places
|
||||
AllocationUnmatchedUsers: Participants without assigned places
|
||||
AllocationUnmatchedCourses: Courses without assigned participants
|
||||
AllocationTime: Time of allocation
|
||||
AllocationCourseEligible: Considered
|
||||
AllocationMatchedUsers: Newly assigned
|
||||
|
||||
#templates allocation/show
|
||||
AllocationSchool: Department
|
||||
AllocationSemester: Semester
|
||||
AllocationDescription: Description
|
||||
AllocationStaffDescription: Staff description
|
||||
AllocationStaffRegisterFrom: Registration of courses starts
|
||||
AllocationStaffRegisterTo: Register courses until
|
||||
AllocationStaffRegister: Registration of courses
|
||||
AllocationStaffAllocationFrom: Grading of applications starts
|
||||
AllocationStaffAllocationTo: Rating of applications until
|
||||
AllocationStaffAllocation: Grading of applications
|
||||
AllocationRegisterFrom: Application period start
|
||||
AllocationRegister: Application period
|
||||
AllocationRegisterClosed: This central allocation is currently closed.
|
||||
AllocationRegisterOpensIn difftime: This central allocation is expected to open in #{difftime}
|
||||
AllocationRegisterByStaff: Enrollment by course administrators
|
||||
AllocationRegisterByStaffFrom: Enrollment by course administrators starts
|
||||
AllocationRegisterByStaffTo: Enrollment by course administrators ends
|
||||
AllocationRegisterByStaffTip: In this periods course administrators may enroll participants in their courses.
|
||||
AllocationRegisterByStaffFromTip: Starting at this time course administrators may enroll participants in their courses.
|
||||
AllocationRegisterByCourse: Direct enrollment
|
||||
AllocationRegisterByCourseFrom: Direct enrollment starts
|
||||
AllocationRegisterByCourseFromTip: Starting at this time course administrators participating in this central allocation may open their courses for participants to manage their participation themselves.
|
||||
AllocationRegisterTo: Registration until
|
||||
AllocationNextSubstitutesDeadline: Next course accepts substitutes until
|
||||
AllocationNextSubstitutesDeadlineNever: No course currently accepts substitutes
|
||||
AllocationFreeCapacity: Free capacity
|
||||
AllocationOverrideDeregister: Leaving courses only until
|
||||
AllocationParticipation: Your participation in this central allocation
|
||||
AllocationParticipationLoginFirst: To participate in this central allocation, please log in first
|
||||
AllocationNotificationLoginFirst: To change your notification settings, please log in first.
|
||||
AllocationCourses: Centrally allocated courses
|
||||
AllocationPriorityTip: Courses to which you assign a higher priority are preferred during the allocation process.
|
||||
AllocationPriorityRelative: The absolute priority values are meaningless. The only consideration is whether one course has a higher priority than another.
|
||||
ApplicationEditTip: During the application period you may edit and retract your applications at will.
|
||||
AllocationNumCoursesAvailableApplied available applied: You have applied for #{applied}/#{available} #{pluralEN applied "course" "courses"}
|
||||
|
||||
AllocationCourseRestrictionDontRestrict: Don't restrict
|
||||
AllocationCourseRestrictionSubstitutes: Courses which currently allow substitute registrations
|
||||
AllocationCourseRestrictionCustom: Custom
|
||||
AllocationName: Name
|
||||
Allocation: Central allocation
|
||||
AllocationActive: Active
|
||||
AllocationUsersApplied: Applications
|
||||
AllocationUsersAssigned: Assignments
|
||||
AllocationUsersVetoed: Vetos
|
||||
AllocationUsersRequested: Requested assignments
|
||||
AllocationUsersPriority: Central priority
|
||||
|
||||
AllocationPriorityNumericValues: Numerical values
|
||||
AllocationPriorityNumericValuesTip: Comma separated whole numbers
|
||||
AllocationPriorityNumericNoValues: No numerical values were provided
|
||||
AllocationPriorityNumericNoParse val: Whole number could not be parsed: “#{val}”
|
||||
AllocationPriorityOrdinalValueNegative: Sorting index may not be negative
|
||||
AllocationPriorityOrdinalValue: Sorting index
|
||||
AllocationPriorityOrdinalValueTip: Zero corresponds to the first entry in the list; higher indices correspond to applicants occurring later in the sorted list and thus to higher central priorities
|
||||
AllocationPriorityNumeric': Numerical
|
||||
AllocationPriorityOrdinal': Based on sorted list
|
||||
AllocationPrioritiesNumeric: Numeric priorities
|
||||
AllocationPrioritiesOrdinal: Priorities based on sorted list
|
||||
AllocationUsersCsvSheetName tid ssh ash: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase ash} Applicants
|
||||
AllocationApplication: Application
|
||||
AllocationProcess: Allocation process
|
||||
AllocationSubstitutesProcess: Allocation of substitutes
|
||||
|
||||
AllocationFormTerm: Term
|
||||
AllocationFormSchool: Department
|
||||
AllocationFormShorthand: Shorthand
|
||||
AllocationFormName: Name
|
||||
AllocationFormLegacyShorthands: Legacy shorthands
|
||||
AllocationFormLegacyShorthandsTip: Allocations are occasionally related to previous versions (e.g. to compare capacity/utilisation). This is done via their shorthand and via the legacy shorthands given here. (Comma-separated list)
|
||||
AllocationFormDescriptions: Description
|
||||
AllocationFormDescription: Description
|
||||
AllocationFormDescriptionTip: Will be shown to all users on the page of the allocation
|
||||
AllocationFormStaffDescription: Description for lecturers
|
||||
AllocationFormStaffDescriptionTip: Will only be shown to (potential) lecturers; will be displayed both when creating a course and on the page of the allocation
|
||||
AllocationFormDeadlines: Deadlines
|
||||
AllocationFormStaffRegisterFrom: Register courses from
|
||||
AllocationFormStaffRegisterFromTip: Starting at this time lecturers may register their courses for the allocation. If no timestamp is given, this will never be permitted.
|
||||
AllocationFormStaffRegisterTo: Register courses until
|
||||
AllocationFormStaffRegisterToTip: If no timestamp is given, registration will initially be possible forever.
|
||||
AllocationFormStaffAllocationFrom: Rating of applications from
|
||||
AllocationFormStaffAllocationFromTip: Starting at this time lecturers may rate applications for their courses. If no timestamp is given, this will never be permitted.
|
||||
AllocationFormStaffAllocationTo: Rating of applications until
|
||||
AllocationFormStaffAllocationToTip: If no timestamp is given, rating will initially be possible forever.
|
||||
AllocationFormRegisterFrom: Application from
|
||||
AllocationFormRegisterFromTip: Starting at this time all users may provide applications for courses participating in this allocation. If no timestamp is given, this will never be permitted.
|
||||
AllocationFormRegisterTo: Application to
|
||||
AllocationFormRegisterToTip: If no timestamp is given, application will initially be possible forever.
|
||||
AllocationFormRegisterByStaffFrom: (De-)registration by lecturers from
|
||||
AllocationFormRegisterByStaffFromTip: Starting at this time lecturers may (de-)register participants from/to their courses directly. If no timestamp is given, this will never be permitted.
|
||||
AllocationFormRegisterByStaffTo: (De-)registration by lecturers until
|
||||
AllocationFormRegisterByStaffToTip: If no timestamp is given, (de-)registration will initially be possible forever.
|
||||
AllocationFormRegisterByCourse: (De-)registration according to course rules from
|
||||
AllocationFormRegisterByCourseTip: Starting at this time users may (de-)register themselves from/to courses participating in the allocation according to the rules of the respective course. If no timestamp is given, direct (de-)registration will never be permitted.
|
||||
AllocationFormOverrideDeregister: Direct deregistration from
|
||||
AllocationFormOverrideDeregisterTip: Up to this time participants of courses participating in the allocation may not deregister themselves, even if it would be allowed according to course rules. If no timestamp is given, deregistration is allowed according to course rules (or as per “_{MsgAllocationFormRegisterByCourse}”).
|
||||
|
||||
AllocationFormStaffRegisterToMustBeAfterFrom: “_{MsgAllocationFormStaffRegisterTo}” must be after “_{MsgAllocationFormStaffRegisterFrom}”.
|
||||
AllocationFormStaffAllocationToMustBeAfterFrom: “_{MsgAllocationFormStaffAllocationTo}” must be after “_{MsgAllocationFormStaffAllocationFrom}”.
|
||||
AllocationFormRegisterToMustBeAfterFrom: “_{MsgAllocationFormRegisterTo}” must be after “_{MsgAllocationFormRegisterFrom}”.
|
||||
AllocationFormRegisterByStaffToMustBeAfterFrom: “_{MsgAllocationFormRegisterByStaffTo}” must be after “_{MsgAllocationFormRegisterByStaffFrom}”.
|
||||
AllocationFormStaffRegisterFromMustBeBeforeStaffAllocationFrom: “_{MsgAllocationFormStaffRegisterFrom}” must be before “_{MsgAllocationFormStaffAllocationFrom}”.
|
||||
AllocationFormStaffRegisterToMustBeBeforeStaffAllocationTo: “_{MsgAllocationFormStaffRegisterTo}” must be before “_{MsgAllocationFormStaffAllocationTo}”.
|
||||
AllocationFormStaffRegisterFromMustBeBeforeRegisterFrom: “_{MsgAllocationFormStaffRegisterFrom}” must be before “_{MsgAllocationFormRegisterFrom}”.
|
||||
AllocationFormStaffRegisterToMustBeBeforeRegisterTo: “_{MsgAllocationFormStaffRegisterTo}” must be before “_{MsgAllocationFormRegisterTo}”.
|
||||
AllocationFormStaffAllocationToShouldBeBeforeRegisterByStaffFrom: “_{MsgAllocationFormStaffAllocationTo}” should be before “_{MsgAllocationFormRegisterByStaffFrom}”.
|
||||
AllocationFormStaffAllocationToShouldBeBeforeRegisterByCourse: “_{MsgAllocationFormStaffAllocationTo}” should be before “_{MsgAllocationFormRegisterByCourse}”.
|
||||
AllocationFormStaffAllocationToShouldBeAfterRegisterTo: “_{MsgAllocationFormStaffAllocationTo}” should be after “_{MsgAllocationFormRegisterTo}”.
|
||||
AllocationFormRegisterToShouldBeBeforeRegisterByStaffFrom: “_{MsgAllocationFormRegisterTo}” should be before “_{MsgAllocationFormRegisterByStaffFrom}”.
|
||||
AllocationFormRegisterToShouldBeBeforeRegisterByCourse: “_{MsgAllocationFormRegisterTo}” should be before “_{MsgAllocationFormRegisterByCourse}”.
|
||||
AllocationFormRegisterByStaffFromShouldBeBeforeRegisterByCourse: “_{MsgAllocationFormRegisterByStaffFrom}” should be before “_{MsgAllocationFormRegisterByCourse}”.
|
||||
|
||||
AllocationNewSuccess: Successfully created allocation
|
||||
AllocationNewAlreadyExists: An allocation with this name/shorthand already exists for this term and department.
|
||||
|
||||
TitleAllocationNew: Create new allocation
|
||||
|
||||
TitleAllocationEdit tid ssh ash: #{toPathPiece tid}-#{ssh}-#{ash}: Edit allocation
|
||||
HeadingAllocationEdit tid ssh aname: Edit allocation: _{ShortTermIdentifier (unTermKey tid)}, #{ssh}, #{aname}
|
||||
|
||||
AllocationEditSuccess: Successfully edited allocation
|
||||
AllocationEditAlreadyExists: Another allocation with this name/shorthand already exists for this term and department.
|
||||
|
||||
TitleAllocationMatchings tid ssh ash: #{toPathPiece tid}-#{ssh}-#{ash}: Matchings
|
||||
HeadingAllocationMatchings tid ssh aname: Matchings: _{ShortTermIdentifier (unTermKey tid)}, #{ssh}, #{aname}
|
||||
AllocationMatchingsNone: No matchings yet
|
||||
AllocationMatchingsLog: Log
|
||||
AllocationMatchingsTime: Timestamp
|
||||
AllocationMatchingsFingerprint: Fingerprint
|
||||
|
||||
AllocationMatchingLogFileName tid ssh ash cID: allocation-matching.#{toPathPiece tid}-#{ssh}-#{ash}.#{toPathPiece cID}.log
|
||||
|
||||
AllocationUserDeleteQuestion: Do you really want to remove the allocation participant listed below?
|
||||
AllocationUserDeleted: Participant successfully removed
|
||||
AllocationApplicationsCount n: #{n} #{pluralENs n "application"}
|
||||
AllocationAllocationsCount n: #{n} #{pluralENs n "allocation"}
|
||||
AllocationCourseHasRatings ratings vetos: This course already has #{ratings} #{pluralENs ratings "rating"} (#{vetos} #{pluralENs vetos "veto"})
|
||||
|
||||
AllocationCourseParticipantFormCourse: Course
|
||||
AllocationCourseParticipantFormIsRegistered: Registered?
|
||||
AllocationCourseParticipantFormIsSelfInflicted: Deregistration “self inflicted” (reason)?
|
||||
AllocationCourseParticipantFormDefaultReason: No Reason
|
||||
|
||||
AllocationUserCourseParticipantFormTitle: Course registrations
|
||||
AllocationUserAllocationUserFormTitle: Participation in allocation
|
||||
@ -1,45 +0,0 @@
|
||||
# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
|
||||
#
|
||||
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
CourseApplicationTitle displayName@Text csh@CourseShorthand: Bewerbung für #{csh}: #{displayName}
|
||||
CourseApplicationArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand appId@CryptoFileNameCourseApplication displayName@Text !ident-ok: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldCase (toPathPiece appId)}-#{foldCase displayName}
|
||||
CourseApplicationsAllocatedDirectory: zentral
|
||||
CourseApplicationsNotAllocatedDirectory: direkt
|
||||
CsvColumnApplicationsAllocation: Zentralanmeldung über die die Bewerbung eingegangen ist
|
||||
CsvColumnApplicationsApplication: Eindeutige Nummer der Bewerbung (zur Zuordnung im ZIP-Archiv aller Bewerbungsdateien)
|
||||
CsvColumnApplicationsName: Voller Name des/der Bewerbers/Bewerberin
|
||||
CsvColumnApplicationsMatriculation: Matrikelnummer des/der Bewerbers/Bewerberin
|
||||
CsvColumnApplicationsEmail: E-Mail-Adresse des/der Bewerbers/Bewerberin
|
||||
CsvColumnApplicationsText: Text-Bewerbung
|
||||
CsvColumnApplicationsHasFiles: Hat der/die Bewerber/Bewerberin Dateien zu seiner Bewerbung eingereicht (siehe ZIP-Archiv aller Bewerbungsdateien)?
|
||||
CsvColumnApplicationsVeto: Bewerber:in mit Veto werden garantiert nicht dem Kurs zugeteilt; "veto" oder leer
|
||||
CsvColumnApplicationsRating: Bewertung der Bewerbung; "1.0", "1.3", "1.7", ..., "4.0", "5.0" (Leer wird behandelt wie eine Note zwischen 2.3 und 2.7)
|
||||
CsvColumnApplicationsComment: Kommentar zur Bewerbung; je nach Kurs-Einstellungen entweder nur als Notiz für die Kursverwalter:innen oder Feedback für den/die Bewerber/Bewerberin
|
||||
CourseApplicationsTableCsvName tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-bewerbungen
|
||||
CourseApplicationIsParticipant: Kursteilnehmer
|
||||
ApplicationUserColumns: Bewerbung
|
||||
ApplicationRatingColumns: Bewertung
|
||||
ApplicationGeneratedColumns: Stammdaten
|
||||
ApplicationGeneratedColumnsTip: Stammdaten eines/einer Bewerbers/Bewerberin sind Daten, welche dem System zu diesem/dieser Benutzer/Benutzerin bekannt sind und welche der/die Benutzer/Benutzerin im Zuge der Bewerbung nicht beeinflussen kann.
|
||||
CourseApplicationVeto !ident-ok: Veto
|
||||
CourseApplicationNoVeto: Kein Veto
|
||||
CourseApplicationNoRatingPoints: Keine Bewertung
|
||||
CourseApplicationNoRatingComment: Kein Kommentar
|
||||
CourseApplicationsListTitle: Bewerbungen
|
||||
AcceptApplicationsMode: Bewerbungen akzeptieren
|
||||
AcceptApplicationsModeTip: Sollen akzeptierte Bewerber:innen direkt als Teilnehmer:in im Kurs eingetragen werden oder sollen Einladungen per E-Mail verschickt werden?
|
||||
AcceptApplicationsSecondary: Gleichstände auflösen
|
||||
AcceptApplicationsSecondaryTip: Wenn es im Laufe des Verfahrens mehrere Bewerber:innen mit der selben Bewertung für den selben Platz gibt, wie soll der Gleichstand aufgelöst werden?
|
||||
CsvColumnUserAppStudyFeatures: Alle relevanten Studiendaten des/der Teilnehmers/Teilnehmerin als Semikolon (;) separierte Liste
|
||||
ApplicationAllocationNoAllocationUser: Dieser Student/diese Studentin nimmt nicht (mehr) an der Zentralvergabe teil. Die Bewerbung existiert zwar noch, wird jedoch bis auf Weiteres sicherlich nicht zu einer Anmeldung führen.
|
||||
|
||||
CourseApplicationId: Bewerbungsnummer
|
||||
CourseApplicationRatingPoints: Bewertung
|
||||
|
||||
#not used as Msg
|
||||
AcceptApplicationsDirect: Direkt anmelden
|
||||
AcceptApplicationsInvite: Einladungen verschicken
|
||||
AcceptApplicationsSecondaryRandom: Zufällig
|
||||
AcceptApplicationsSecondaryTime: Nach Zeitpunkt der Bewerbung
|
||||
CourseApplicationsTableCsvSheetName tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh} Bewerbungen
|
||||
@ -1,46 +0,0 @@
|
||||
# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
|
||||
#
|
||||
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
CourseApplicationTitle displayName csh: Application for #{csh}: #{displayName}
|
||||
CourseApplicationArchiveName tid ssh csh appId displayName: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldCase (toPathPiece appId)}-#{foldCase displayName}
|
||||
CourseApplicationsAllocatedDirectory: central
|
||||
CourseApplicationsNotAllocatedDirectory: direct
|
||||
CsvColumnApplicationsAllocation: Central allocation for which this application was made
|
||||
CsvColumnApplicationsApplication: Globally unique number of application (for matching with the ZIP archive of all application files)
|
||||
CsvColumnApplicationsName: Participant's full name
|
||||
CsvColumnApplicationsMatriculation: Participant's matriculation
|
||||
CsvColumnApplicationsEmail: Participant's email address
|
||||
CsvColumnApplicationsText: Application text
|
||||
CsvColumnApplicationsHasFiles: Did the applicant provide any additional files with their application (see ZIP archive of all application files)?
|
||||
CsvColumnApplicationsVeto: Vetoed applicants are never assigned to the course; "veto" or empty
|
||||
CsvColumnApplicationsRating: Application grading; Any number grade ("1.0", "1.3", "1.7", ..., "4.0", "5.0"); Empty cells will be treated as if they contained a grade between 2.3 and 2.7
|
||||
CsvColumnApplicationsComment: Application comment; depending on course settings this might purely be a note for course administrators or be feedback for the applicant
|
||||
CourseApplicationsTableCsvName tid ssh csh: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-applications
|
||||
CourseApplicationIsParticipant: Course participant
|
||||
ApplicationUserColumns: Application
|
||||
ApplicationRatingColumns: Rating
|
||||
ApplicationGeneratedColumns: Master data
|
||||
ApplicationGeneratedColumnsTip: An applicant's master data is data which is known to the system about this user and which the user cannot modify when applying for the course.
|
||||
CourseApplicationVeto: Veto
|
||||
CourseApplicationNoVeto: No veto
|
||||
CourseApplicationNoRatingPoints: No grading
|
||||
CourseApplicationNoRatingComment: No comment
|
||||
CourseApplicationsListTitle: Applications
|
||||
AcceptApplicationsMode: Accept applications
|
||||
AcceptApplicationsModeTip: Should accepted applications be enrolled in the course directly or should invitations be sent via email?
|
||||
AcceptApplicationsSecondary: Breaking ties
|
||||
AcceptApplicationsSecondaryTip: If a tie occurs during the acceptance process, how should it be broken?
|
||||
CsvColumnUserAppStudyFeatures: All relevant features of study for the participant, separated by semicolon (;)
|
||||
ApplicationAllocationNoAllocationUser: This student does not (or does no longer) participate in the allocation. The application still exists, but will certainly not lead to a registriation while it is in this state.
|
||||
|
||||
CourseApplicationId: Application number
|
||||
CourseApplicationRatingPoints: Grading
|
||||
|
||||
#not used as Msg
|
||||
AcceptApplicationsDirect: Enroll directly
|
||||
AcceptApplicationsInvite: Send invitations
|
||||
AcceptApplicationsSecondaryRandom: Randomly
|
||||
AcceptApplicationsSecondaryTime: By time of application
|
||||
CourseApplicationsTableCsvSheetName tid ssh csh: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh} Applications
|
||||
|
||||
@ -12,9 +12,6 @@ FilterCourseSearchShorthand: Kürzel-Suche
|
||||
FilterCourseSearchTitle: Titel-Suche
|
||||
FilterCourseRegistered: Registriert
|
||||
FilterCourseRegisterOpen: Anmeldung möglich
|
||||
FilterCourseAllocation: Zentralanmeldung
|
||||
FilterCourseAllocationNone: Keine Zentralanmeldung
|
||||
FilterCourseAllocationOption tid@TermId ssh@SchoolId aname@AllocationName !ident-ok: #{toPathPiece tid} #{ssh} #{aname}
|
||||
CourseRegistered: Angemeldet
|
||||
CourseRegistration: Anmeldung
|
||||
CourseDescription: Beschreibung
|
||||
@ -25,13 +22,6 @@ CourseLecturerAlreadyAdded: Diese:r Nutzer:in ist bereits als Kursverwalter:in e
|
||||
CourseLecturerType: Rolle
|
||||
LecturerType: Rolle
|
||||
CourseLecturerRightsIdentical: Alle Sorten von Kursverwalter:innen haben identische Rechte.
|
||||
CourseAllocationOption term@Text name@Text !ident-ok: #{name} (#{term})
|
||||
CourseAllocationParticipate: Teilnahme an Zentralanmeldung
|
||||
CourseNoAllocationsAvailable: Es sind aktuell keine Zentralanmeldungen verfügbar
|
||||
CourseAllocation: Zentralanmeldung
|
||||
CourseAllocationMinCapacity: Minimale Teilnehmeranzahl
|
||||
CourseAllocationMinCapacityTip: Wenn der Veranstaltung bei der Zentralanmeldung weniger als diese Anzahl von Teilnehmer:innen zugeteilt würden, werden diese stattdessen auf andere Kurse umverteilt
|
||||
CourseAllocationMinCapacityMustBeNonNegative: Minimale Teilnehmeranzahl darf nicht negativ sein
|
||||
CourseAcceptSubstitutesUntil: Nachrücker:innen akzeptieren bis
|
||||
CourseAcceptSubstitutesUntilTip: Bis zu welchem Zeitpunkt sollen durch die Zentralanmeldung Nachrücker:innen diesem Kurs zugewiesen werden? Wird kein Datum angegeben werden nach der Initialen Verteilung nie Nachrücker:innen zugewiesen. Diese Frist sollte nicht willkürlich früh bzw. nicht gesetzt werden, um für die Studierenden keine unnötige Beschränkung darzustellen. Geeignet ist z.B. bei einem Seminar wenige Stunden vor dem ersten Treffen zum Verteilen der Themen.
|
||||
CourseDeregisterNoShow: „Nicht erschienen“ bei Abmeldung
|
||||
@ -53,18 +43,6 @@ CourseVisibleToTip: Der Kurs ist ab "Sichtbar ab" bis zu diesem Zeitpunkt für a
|
||||
CourseMaterialFree: Das Kursmaterial ist ohne Anmeldung frei zugänglich
|
||||
CourseFormSectionRegistration: Anmeldung zum Kurs
|
||||
CourseFormSectionAdministration: Verwaltung
|
||||
CourseApplicationInstructions: Anweisungen zur Bewerbung/Anmeldung
|
||||
CourseApplicationInstructionsTip: Wird den Studierenden angezeigt, wenn diese sich für Ihre Veranstaltung bewerben bzw. bei dieser anmelden
|
||||
CourseApplicationRequired: Bewerbungsverfahren
|
||||
CourseApplicationRequiredTip: Sollen Anmeldungen zu diesem Kurs zunächst provisorisch (ohne Kapazitätsbeschränkung) sein, bis sie durch einen Kursverwalter (nach Bewertung der Bewerbungen) akzeptiert werden?
|
||||
CourseApplicationTemplate: Bewerbungsvorlagen
|
||||
CourseApplicationTemplateTip: Werden den Studierenden zum download angeboten, wenn diese sich für Ihre Veranstaltung bewerben bzw. bei dieser anmelden
|
||||
CourseApplicationsText: Text-Bewerbungen
|
||||
CourseApplicationsTextTip: Sollen die Studierenden bei Ihrer Bewerbung bzw. Anmeldung (ggf. zusätzlich zu abgegebenen Dateien) auch unformatierten Text einreichen können?
|
||||
CourseApplicationsFiles: Bewerbungsdateien
|
||||
CourseApplicationsFilesTip: Sollen die Studierenden bei Ihrer Bewerbung bzw. Anmeldung (ggf. zusätzlich zu unformatiertem Text) auch Dateien abgeben können?
|
||||
CourseApplicationRatingsVisible: Feedback für Bewerbungen
|
||||
CourseApplicationRatingsVisibleTip: Sollen Bewertung und Kommentar der Bewerbungen den Studierenden nach Ende der Bewertungs-Phase angezeigt werden?
|
||||
CourseCapacity: Kapazität
|
||||
CourseCapacityTip: Anzahl erlaubter Kursanmeldungen, leer lassen für unbeschränkte Kurskapazität
|
||||
CourseSecretTip: Anmeldung zum Kurs erfordert Eingabe des Passworts, sofern gesetzt
|
||||
@ -80,15 +58,9 @@ CourseDeregisterUntilTip: Abmeldung ist ab "Anmeldungen von" bis zu diesem Zeitp
|
||||
CourseVisibilityEndMustBeAfterStart: Ende des Sichtbarkeitszeitraums muss nach dem Anfang liegen
|
||||
CourseRegistrationEndMustBeAfterStart: Ende des Anmeldezeitraums muss nach dem Anfang liegen
|
||||
CourseDeregistrationEndMustBeAfterStart: Ende des Abmeldezeitraums muss nach dem Anfang des Anmeldezeitraums liegen
|
||||
CourseAllocationRequiresCapacity: Bei Teilnahme an einer Zentralanmeldung muss eine Kurskapazität angegeben werden
|
||||
CourseAllocationTermMustMatch: Kurs-Semester muss mit Semester der Zentralanmeldung übereinstimmen
|
||||
CourseUserMustBeLecturer: Aktuelle:r Benutzer:in muss als Kursverwalter:in eingetragen sein
|
||||
CourseAllocationCapacityMayNotBeChanged: Kapazität eines Kurses, der an einer Zentralanmeldung teilnimmt, darf nicht nachträglich verändert werden
|
||||
AllocationStaffRegisterToExpiredAllocation: Die Frist zur Eintrageng von Kursen in die Zentralanmeldung ist verstrichen. Die Teilnahme darf nicht mehr verändert werden.
|
||||
AllocationStaffRegisterToExpiredMinCapacity: Die Frist zur Eintrageng von Kursen in die Zentralanmeldung ist verstrichen. Die minimale Kapazität darf nicht mehr verändert werden.
|
||||
CourseShorthandTooLong: Lange Kurskürzel können zu Problemen bei der Darstellung und der Kommunikation mit den Studierenden führen. Bitte wählen Sie ein weniger langes Kürzel, falls möglich.
|
||||
CourseNotAlwaysVisibleDuringRegistration: Um Studierenden über den gesamten Anmeldezeitraum hinweg die Anmeldung zum Kurs zu ermöglichen, sollte der Kurs auch über den gesamten Anmeldezeitraum hinweg sichtbar sein (dies ist aktuell nicht gegeben).
|
||||
CourseApplicationInstructionsRecommended: Studierende können bei ihrer Anmeldung/Bewerbung nach aktuellen Einstellungen Texte bzw. Dateien abgeben. Es wurden jedoch keine Anweisungen zur Bewerbung oder Vorlage-Dateien hinterlegt. Sie sollten entweder keine Texte bzw. Dateien verlangen oder über Anweisungen bzw. Vorlagen klarstellen, was Sie von den Studierenden erwarten.
|
||||
NoSuchTerm tid@TermId: Semester #{tid} gibt es nicht.
|
||||
NoSuchSchool ssh@SchoolId: Institut #{ssh} gibt es nicht.
|
||||
NoSuchCourseShorthand csh@CourseShorthand: Kein Kurs mit Kürzel #{csh} bekannt.
|
||||
@ -127,20 +99,12 @@ CourseParticipantsRegisterConfirmationHeading: Teilnehmer:innen hinzufügen
|
||||
CourseParticipantsRegisterUnnecessary: Alle angeforderten Anmeldungen sind bereits vorhanden. Es wurden keine Änderungen vorgenommen.
|
||||
CourseParticipantsRegisterConfirmInvalid: Ungültiges Bestätigungsformular!
|
||||
|
||||
CourseApplicationText: Text-Bewerbung
|
||||
CourseApplicationFollowInstructions: Beachten Sie die Anweisungen zur Bewerbung!
|
||||
CourseRegistrationText: Text zur Anmeldung
|
||||
CourseRegistrationFollowInstructions: Beachten Sie die Anweisungen zur Anmeldung!
|
||||
CourseRegistrationFiles: Datei(en) zur Anmeldung
|
||||
CourseApplicationNoFiles: Keine Datei(en)
|
||||
CourseApplicationFilesNeedReupload: Bewerbungsdateien müssen neu hochgeladen werden, wann immer die Bewerbung angepasst wird
|
||||
CourseRegistrationFilesNeedReupload: Dateien zur Anmeldung müssen neu hochgeladen werden, wann immer die Anmeldung angepasst wird
|
||||
CourseApplicationFile: Bewerbung
|
||||
CourseApplicationFiles: Bewerbungsdatei(en)
|
||||
CourseApplicationArchive: Zip-Archiv der Bewerbungsdatei(en)
|
||||
CourseRegistrationFile: Datei zur Anmeldung
|
||||
CourseRegistrationArchive: Zip-Archiv der Datei(en) zur Anmeldung
|
||||
CourseDeregistrationAllocationLog: Ihr Platz in diesem Kurs stammt aus einer Zentralanmeldung. Wenn Sie sich vom Kurs abmelden wird dieser Umstand permanent im System gespeichert und kann Sie u.U. bei zukünftigen Zentralanmeldungen benachteiligen. Wenn Sie gute Gründe vorzuweisen haben, warum Ihre Abmeldung nicht selbstverschuldet ist, kontaktieren Sie bitte eine:n Kursverwalter:in. Diese haben die Möglichkeit Sie ohne permanente Eintragung im System abzumelden.
|
||||
CourseDeregistrationNoShow: Wenn Sie sich vom Kurs abmelden, wird für alle Prüfungen des Kurses „nicht erschienen“ gemeldet. Wenn Sie gute Gründe vorzuweisen haben, warum Ihre Abmeldung nicht selbstverschuldet ist, kontaktieren Sie bitte eine:n Kursverwalter:in. Diese haben die Möglichkeit Sie ohne permanente Eintragung im System abzumelden.
|
||||
CourseDeregistrationFromInvisibleCourse: Dieser Kurs ist nur für angemeldete Teilnehmer:innen und Bewerber:innen sichtbar. Wenn Sie sich jetzt abmelden, können Sie danach nicht wieder auf den Kurs zugreifen!
|
||||
CourseDeregistrationNoReRegistration: Wenn Sie sich jetzt vom Kurs abmelden, können Sie sich nicht wieder selbstständig anmelden.
|
||||
@ -150,15 +114,8 @@ CourseRegisterOk: Erfolgreich zum Kurs angemeldet
|
||||
CourseDeregisterOk: Erfolgreich vom Kurs abgemeldet
|
||||
CourseApplyOk: Erfolgreich zum Kurs beworben
|
||||
CourseRetractApplyOk: Bewerbung zum Kurs erfolgreich zurückgezogen
|
||||
CourseApplicationTemplateArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-bewerbungsvorlagen
|
||||
CourseMemberOf: Teilnehmer:in von
|
||||
CourseAssociatedWith: assoziiert mit
|
||||
CourseDeregistrationAllocationReason: Grund
|
||||
CourseDeregistrationAllocationReasonTip: Der angegebene Grund wird permanent im System hinterlegt und ist i.A. einziger Anhaltspunkt zur Schlichtung etwaiger Konflikte
|
||||
CourseDeregistrationAllocationNoShow: „Nicht erschienen“ eintragen
|
||||
CourseDeregistrationAllocationNoShowTip: Soll für alle Prüfungen dieses Kurses „nicht erschienen“ als Prüfungsleistung eingetragen werden? Dies geschieht einmalig bei der Abmeldung (sofern nicht bereits eine Prüfungsleistung existiert) und automatisch beim Anlegen von neuen Prüfungen.
|
||||
CourseDeregistrationAllocationShouldLog: Selbstverschuldet
|
||||
CourseDeregistrationAllocationShouldLogTip: Falls der Platz des Studierenden, der abgemeldet wird, aus einer Zentralanmeldung stammt, ist vorgesehen einen permanenten Eintrag im System zu speichern, der den Studierenden u.U. bei zukünftigen Zentralanmeldungen benachteiligt. Als Kursverwalter:in haben Sie die Möglichkeit dies zu unterbinden, wenn der Studierende gute Gründe vorweisen kann, warum seine Abmeldung nicht selbstverschuldet ist.
|
||||
CourseLastEdit: Letzte Änderung
|
||||
CourseUserNote: Notiz
|
||||
CourseUserNoteTooltip: Nur für Verwalter dieses Kurses einsehbar
|
||||
@ -217,17 +174,11 @@ CourseParticipantsCount n@Int !ident-ok: #{n}
|
||||
CourseParticipantsCountOf n@Int m@Int: #{n} von #{m}
|
||||
CourseVisibility: Sichtbarkeit
|
||||
CourseInvisible: Dieser Kurs ist momentan nur für Dozierende, Assistent:innen, Tutor:innen, Korrektor:innen, angemeldete Teilnehmer:innen und Bewerber:innen sichtbar.
|
||||
CourseInvisibleOverridenByAllocation: Da die Zentralanmeldung, an welcher der Kurs teilnimmt aktuell offen für Bewerbungen ist, wird die Kurssichtbarkeit während der Bewerbungsphase forciert. Außerhalb der Bewerbungsphase ist der Kurs nur für Dozierende, Assistent:innen, Tutor:innen, Korrektor:innen, angemeldete Teilnehmer:innen und Bewerber:innen sichtbar.
|
||||
CourseRegistrationInterval: Anmeldung
|
||||
CourseDirectRegistrationInterval: Direkte Anmeldung
|
||||
CourseDeregisterUntil time@Text: Abmeldung nur bis #{time}
|
||||
CourseApplicationInstructionsApplication: Anweisungen zur Bewerbung
|
||||
CourseApplicationInstructionsRegistration: Anweisungen zur Anmeldung
|
||||
CourseApplicationTemplateApplication: Bewerbungsvorlage(n)
|
||||
CourseApplicationTemplateRegistration: Anmeldungsvorlage(n)
|
||||
NotRegistered: Sie sind zu diesem Kurs nicht angemeldet.
|
||||
CourseApplicationDeleteToEdit: Um Ihre Bewerbung zu editieren müssen Sie sie zunächst zurückziehen und sich erneut bewerben.
|
||||
CourseMaterial !ident-ok: Material
|
||||
NotRegistered: Nicht zum Kurs angemeldet
|
||||
CourseMaterialNotFree: Das Kursmaterial ist nur für Mitglieder des Kurses einsehbar, also z.B. für Teilnehmer:innen, Tutor:innen, Korrektor:innen und Verwalter:innen.
|
||||
CourseMaterialsFoundHere: Material zum Kurs finden Sie hier
|
||||
CourseMaterialsNoneVisible: Aktuell gibt es zu diesem Kurs kein Material, oder nur Material auf das Sie keinen Zugriff haben (z.B. aufgrund von Fristen bzgl. der Sichtbarkeit).
|
||||
@ -251,17 +202,8 @@ StudyTerms: Studiengänge
|
||||
NoStudyTermsKnown: Keine Studiengänge bekannt
|
||||
CourseMembersCountOf n@Int mbNum@(Maybe Int): #{n} Kursanmeldungen #{maybeToMessage " von " mbNum " möglichen"}
|
||||
|
||||
#template course/application
|
||||
CourseAllocationsBounds n@Int: Voraussichtliche Zuteilungen durch #{pluralDE n "Zentralanmeldung" "Zentralanmeldungen"}
|
||||
CourseAllocationsBoundCoincide numFirstChoice@Int: Vstl. #{numFirstChoice} #{pluralDE numFirstChoice "Teinehmer:in" "Teinehmer:innen"}
|
||||
CourseAllocationsBound numApps@Int numFirstChoice@Int: Vstl. zwischen #{numFirstChoice} und #{numApps} #{pluralDE numApps "Teinehmer:in" "Teinehmer:innen"}
|
||||
CourseAllocationsBoundCapped: Die obige Anzeige wurde durch die aktuell angegebene Kurskapazität reduziert.
|
||||
CourseAllocationsBoundWarningOpen: Diese Informationen entsprechen nur dem aktuellen Stand der Bewerbungen und können sich noch ändern.
|
||||
CourseApplications: Bewerbungen
|
||||
|
||||
CourseLoginToApply: Um sich zum Kurz zu bewerben müssen Sie sich zunächst in Uni2work anmelden
|
||||
CourseLoginToRegister: Um sich zum Kurs anzumelden müssen Sie zunächst in Uni2work anmelden
|
||||
CourseAllApplicationsArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-bewerbungen
|
||||
CourseLecInviteHeading courseName@Text: Einladung zum/zur Kursverwalter/Kursverwalterin für #{courseName}
|
||||
CourseLecInviteExplanation: Sie wurden eingeladen, Verwalter:in für einen Kurs zu sein.
|
||||
CourseUserHasPersonalisedSheetFilesFilter: Teilnehmer:in hat personalisierte Übungsblatt-Dateien für
|
||||
@ -277,13 +219,6 @@ CourseUserDownloadPersonalisedSheetFiles: Personalisierte Übungsblätter herunt
|
||||
CourseUserSetSubmissionGroup: Gruppenabgabe hinzufügen
|
||||
CourseUserReRegister: Teilnehmer:in registrieren
|
||||
|
||||
CourseApplicationsTableCsvSetVeto: Veto hinzufügen
|
||||
CourseApplicationsTableCsvSetRating: Rating hinzufügen
|
||||
CourseApplicationsTableCsvSetComment: Kommentar hinzufügen
|
||||
CourseApplicationsTableCsvExceptionNoMatchingUser: Kein:e passende:r Benutzer:in
|
||||
CourseApplicationsTableCsvExceptionNoMatchingAllocation: Keine passende Bewerbung
|
||||
CourseApplicationsTableCsvExceptionNoMatchingStudyFeatures: Kein passendes Studienfach
|
||||
|
||||
CoursePersonalisedSheetFilesArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-personalisierte_dateien
|
||||
|
||||
TutorialFreeCapacity: Freie Plätze
|
||||
|
||||
@ -12,9 +12,6 @@ FilterCourseSearchShorthand: Shorthand search
|
||||
FilterCourseSearchTitle: Title search
|
||||
FilterCourseRegistered: Registered
|
||||
FilterCourseRegisterOpen: Enrolment is allowed
|
||||
FilterCourseAllocation: Central allocation
|
||||
FilterCourseAllocationNone: No allocation
|
||||
FilterCourseAllocationOption tid ssh aname: #{toPathPiece tid} #{ssh} #{aname}
|
||||
CourseRegistered: Enrolled
|
||||
CourseRegistration: Enrolment
|
||||
CourseDescription: Description
|
||||
@ -25,13 +22,6 @@ CourseLecturerAlreadyAdded: This user is already configured as a course administ
|
||||
CourseLecturerType: Role
|
||||
LecturerType: Role
|
||||
CourseLecturerRightsIdentical: All sorts of course administrators have the same permissions.
|
||||
CourseAllocationOption term name: #{name} (#{term})
|
||||
CourseAllocationParticipate: Participate in central allocation
|
||||
CourseNoAllocationsAvailable: There are no ongoing central allocations
|
||||
CourseAllocation: Central allocation
|
||||
CourseAllocationMinCapacity: Minimum number of participants
|
||||
CourseAllocationMinCapacityTip: If fewer students than this number were to be assigned to this course, then these students would instead be assigned to other courses
|
||||
CourseAllocationMinCapacityMustBeNonNegative: Minimum number of participants must not be negative
|
||||
CourseAcceptSubstitutesUntil: Accept substitute registrations until
|
||||
CourseAcceptSubstitutesUntilTip: Until which time should substitute registrations through the central allocation be accepted to fill free places in the course? If left empty no substitute registrations will be made. This deadline should not arbitrarily be set early or ommitted so as to not be an unneccesarily restrictive for students. For a seminar a valid choice might be a few hours before the first meeting in which topics will be assigned.
|
||||
CourseDeregisterNoShow: Record “no show” when deregistering
|
||||
@ -53,18 +43,6 @@ CourseVisibleToTip: Other users will be able to see the course from "Visible Fro
|
||||
CourseMaterialFree: Course material is publicly accessible
|
||||
CourseFormSectionRegistration: Registration
|
||||
CourseFormSectionAdministration: Administration
|
||||
CourseApplicationInstructions: Instructions for application
|
||||
CourseApplicationInstructionsTip: Will be shown to students if they decide to apply for this course
|
||||
CourseApplicationRequired: Applications required
|
||||
CourseApplicationRequiredTip: Should registrations for this course be provisional at first (without capacity constraint), until they are approved by a course administrator?
|
||||
CourseApplicationTemplate: Application template
|
||||
CourseApplicationTemplateTip: Students can download this template if they decide to apply for this course
|
||||
CourseApplicationsText: Text application
|
||||
CourseApplicationsTextTip: Should students submit plaintext with their application/registration (in addition to submitted files if applicable)?
|
||||
CourseApplicationsFiles: Application files
|
||||
CourseApplicationsFilesTip: Should students submit files with their application/registration (in addition to plaintext if applicable)?
|
||||
CourseApplicationRatingsVisible: Feedback to applications
|
||||
CourseApplicationRatingsVisibleTip: Should students be allowed to view rating and comments on their application after the rating period?
|
||||
CourseCapacity: Capacity
|
||||
CourseCapacityTip: Maximum permissable number of enrolments for this course; leave empty for unlimited capacity
|
||||
CourseSecretTip: Enrollment for this course will require the password, if set
|
||||
@ -80,15 +58,9 @@ CourseDeregisterUntilTip: Participants may deregister from immediately after reg
|
||||
CourseVisibilityEndMustBeAfterStart: The end of the visibility period must be after its start
|
||||
CourseRegistrationEndMustBeAfterStart: The end of the registration period must be after its start
|
||||
CourseDeregistrationEndMustBeAfterStart: The end of the deregistration period must be after the start of the registration period
|
||||
CourseAllocationRequiresCapacity: Course capacity needs to be specified if the course participates in a central allocation
|
||||
CourseAllocationTermMustMatch: Course semester needs to match the semester of the central allocation
|
||||
CourseUserMustBeLecturer: The current user needs to be a course administrator
|
||||
CourseAllocationCapacityMayNotBeChanged: The capacity of a course that participates in a central allocation must not be altered
|
||||
AllocationStaffRegisterToExpiredAllocation: The course registration period for the central allocation is over. Participation may not be changed.
|
||||
AllocationStaffRegisterToExpiredMinCapacity: The course registration period for the central allocation is over. Minimum capacity may not be changed.
|
||||
CourseShorthandTooLong: Long course shorthands may lead to display issues and might complicate communication with students. Please choose a more concise shorthand if possible.
|
||||
CourseNotAlwaysVisibleDuringRegistration: To allow for students to register, the course should also be visible during the entire registration period (which is currently not the case).
|
||||
CourseApplicationInstructionsRecommended: Students can, as per the current course settings, submit files and/or texts with their applications/registrations. There are, however, no instructions for application or template files. You should either not require files/texts or clarify through instructions or templates what is expected of the students.
|
||||
NoSuchTerm tid: Semester #{tid} does not exist.
|
||||
NoSuchSchool ssh: Department #{ssh} does not exist.
|
||||
NoSuchCourseShorthand csh: There is no course with shorthand #{csh}.
|
||||
@ -127,20 +99,12 @@ CourseParticipantsRegisteredTutorial n: Successfully registered #{n} #{pluralEN
|
||||
CourseParticipantsRegisterConfirmationHeading: Register participants
|
||||
CourseParticipantsRegisterConfirmInvalid: Invalid confirmation form!
|
||||
|
||||
CourseApplicationText: Application text
|
||||
CourseApplicationFollowInstructions: Please follow the instructions for applications!
|
||||
CourseRegistrationText: Registration text
|
||||
CourseRegistrationFollowInstructions: Please follow the instructions for registrations!
|
||||
CourseRegistrationFiles: Registration file(s)
|
||||
CourseApplicationNoFiles: No file(s)
|
||||
CourseApplicationFilesNeedReupload: Application files need to be reuploaded every time the application is changed
|
||||
CourseRegistrationFilesNeedReupload: Registration files need to be reuploaded every time the registration is changed
|
||||
CourseApplicationFile: Application
|
||||
CourseApplicationFiles: Application file(s)
|
||||
CourseApplicationArchive: Zip archive of application files
|
||||
CourseRegistrationFile: Registration file
|
||||
CourseRegistrationArchive: Zip archive of registration files
|
||||
CourseDeregistrationAllocationLog: Your enrollment in this course is due to a central allocation. If you leave the course, this will be permanently recorded and might affect you negatively in future central allocations. If you have good reasons why you should not be held accountable for leaving the course, please contact a course administrator. Course administrators can deregister you without incurring a permanent record.
|
||||
CourseDeregistrationNoShow: If you deregister from this course “no show” will be recorded as your exam achievement for all exams associated with this course. If you have good reasons why you shold not be held accountable for leaving the course, please contact a course administrator. Course administrators can deregister you without incurring a permanent record.
|
||||
CourseDeregistrationFromInvisibleCourse: This course is only visible to enrolled participants and applicants. If you deregister now, you will not be able to access the course again!
|
||||
CourseDeregistrationNoReRegistration: If you deregister from the course now, you will not be able to re-register yourself.
|
||||
@ -150,15 +114,8 @@ CourseRegisterOk: Successfully enrolled for course
|
||||
CourseDeregisterOk: Successfully left course
|
||||
CourseApplyOk: Successfully applied for course
|
||||
CourseRetractApplyOk: Successfully retracted application for course
|
||||
CourseApplicationTemplateArchiveName tid ssh csh: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-application-templates
|
||||
CourseMemberOf: Participant of
|
||||
CourseAssociatedWith: associated with
|
||||
CourseDeregistrationAllocationReason: Reason
|
||||
CourseDeregistrationAllocationReasonTip: The specified reason will be permanently stored and might be the only information available during conflict resolution
|
||||
CourseDeregistrationAllocationNoShow: Record as “no show”
|
||||
CourseDeregistrationAllocationNoShowTip: Should, for all exams associated with this course, “no show” be recorded as the exam achievement automatically? This would be done once immediately (if no other achievement exists for the given exam) and automatically whenever a new exam is created.
|
||||
CourseDeregistrationAllocationShouldLog: Self imposed
|
||||
CourseDeregistrationAllocationShouldLogTip: If the participant was enrolled in this course due to a central allocation, it is intended that a permanent record be made that might affect the student negatively in future central allocations. As a course administrator you have the right to prevent this if the participant can present good reasons why them leaving the course is not self imposed.
|
||||
CourseLastEdit: Latest edit
|
||||
CourseUserNote: Note
|
||||
CourseUserNoteTooltip: Only visible to administrators of this course
|
||||
@ -217,16 +174,10 @@ CourseParticipantsCount n: #{n}
|
||||
CourseParticipantsCountOf n m: #{n} of #{m}
|
||||
CourseVisibility: Visibility
|
||||
CourseInvisible: This course is currently only visible to lecturers, assistants, tutors, correctors, enrolled participants and applicants.
|
||||
CourseInvisibleOverridenByAllocation: Because the allocation this course participates in is currently open for application, the course is forced to be visible. After the application phase, the course will only be visible to lecturers, assistants, tutors, correctors, enrolled participants and applicants.
|
||||
CourseRegistrationInterval: Enrolment
|
||||
CourseDirectRegistrationInterval: Direct enrolment
|
||||
CourseDeregisterUntil time: Deregistration only until #{time}
|
||||
CourseApplicationInstructionsApplication: Instructions for application
|
||||
CourseApplicationInstructionsRegistration: Instructions for registration
|
||||
CourseApplicationTemplateApplication: Application template(s)
|
||||
CourseApplicationTemplateRegistration: Registration template(s)
|
||||
NotRegistered: Note enrolled for this course
|
||||
CourseApplicationDeleteToEdit: You need to withdraw your application and reapply to edit your application.
|
||||
CourseMaterial: Material
|
||||
CourseMaterialNotFree: Course material is only accessible to members of the course, e.g. for participants, tutors, correctors or administratiors.
|
||||
CourseMaterialsFoundHere: Material for this course is available here
|
||||
@ -251,17 +202,8 @@ StudyTerms: Fields of study
|
||||
NoStudyTermsKnown: No known features of study
|
||||
CourseMembersCountOf n mbNum: #{n} #{maybeToMessage "of " mbNum " "}participants
|
||||
|
||||
#template course/application
|
||||
CourseAllocationsBounds n: Expected number of alloctions due to #{pluralEN n "central allocation" "central allocations"}
|
||||
CourseAllocationsBoundCoincide numFirstChoice: Est. #{numFirstChoice} #{pluralEN numFirstChoice "participant" "participants"}
|
||||
CourseAllocationsBound numApps numFirstChoice: Est. between #{numFirstChoice} and #{numApps} #{pluralEN numApps "participant" "participants"}
|
||||
CourseAllocationsBoundCapped: The numbers listed above were modified based on the currently configured course capacity.
|
||||
CourseAllocationsBoundWarningOpen: The information listed above represents only the current state of applications and is subject to change.
|
||||
CourseApplications: Applications
|
||||
|
||||
CourseLoginToApply: You need to login to Uni2work before you can apply for this course.
|
||||
CourseLoginToRegister: Your need to login to Uni2work before you can register for this course.
|
||||
CourseAllApplicationsArchiveName tid ssh csh: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-applications
|
||||
CourseLecInviteHeading courseName: Invitation to be a course administrator for #{courseName}
|
||||
CourseLecInviteExplanation: You were invited to be a course administrator.
|
||||
CourseUserHasPersonalisedSheetFilesFilter: Participant has personalised sheet files for
|
||||
@ -276,13 +218,6 @@ CourseUserSetSubmissionGroup: Set group-submission
|
||||
CourseUserReRegister: Reregister participant
|
||||
CourseUserDownloadPersonalisedSheetFiles: Download personalised sheets
|
||||
|
||||
CourseApplicationsTableCsvSetVeto: Set veto
|
||||
CourseApplicationsTableCsvSetRating: Set rating
|
||||
CourseApplicationsTableCsvSetComment: Set comment
|
||||
CourseApplicationsTableCsvExceptionNoMatchingUser: No matching user
|
||||
CourseApplicationsTableCsvExceptionNoMatchingAllocation: No matching allocation
|
||||
CourseApplicationsTableCsvExceptionNoMatchingStudyFeatures: no matching study features
|
||||
|
||||
CoursePersonalisedSheetFilesArchiveName tid ssh csh: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-personalised_files
|
||||
|
||||
TutorialFreeCapacity: Free capacity
|
||||
|
||||
@ -9,7 +9,6 @@ InfoLecturerCourses: Veranstaltungen
|
||||
InfoLecturerExercises: Übungsbetrieb
|
||||
InfoLecturerTutorials: Tutorien
|
||||
InfoLecturerExams: Prüfungen
|
||||
InfoLecturerAllocations: Zentralanmeldungen
|
||||
LecturerInfoTooltipNew: Neues Feature
|
||||
LecturerInfoTooltipProblem: Feature mit bekannten Problemen
|
||||
LecturerInfoTooltipPlanned: Geplantes Feature
|
||||
@ -20,7 +19,6 @@ VersionHistory: Versionsgeschichte
|
||||
KnownBugs: Bekannte Bugs
|
||||
ImplementationDetails: Implementierung
|
||||
Clone: Klonen
|
||||
Applicant: Bewerber:in
|
||||
Administrator: Administrator:in
|
||||
CommCourse: Kursmitteilung
|
||||
Corrector: Korrektor:in
|
||||
|
||||
@ -9,7 +9,6 @@ InfoLecturerCourses: Courses
|
||||
InfoLecturerExercises: Course Exercises
|
||||
InfoLecturerTutorials: Tutorials
|
||||
InfoLecturerExams: Exams
|
||||
InfoLecturerAllocations: Central allocations
|
||||
LecturerInfoTooltipNew: New feature
|
||||
LecturerInfoTooltipProblem: Feature with known issues
|
||||
LecturerInfoTooltipPlanned: Planned feature
|
||||
@ -21,7 +20,6 @@ KnownBugs: Known bugs
|
||||
ImplementationDetails: Implementation
|
||||
Clone: Cloning
|
||||
Administrator: Administrator
|
||||
Applicant: Applicant
|
||||
CommCourse: Course message
|
||||
Corrector: Corrector
|
||||
DefinitionCourseEvents: Course occurrences
|
||||
|
||||
@ -15,7 +15,6 @@ ResetPassword: FRADrive-Passwort ändern bzw. setzen
|
||||
MailSubjectChangeUserDisplayEmail: Diese E-Mail-Adresse in FRADrive veröffentlichen
|
||||
MailIntroChangeUserDisplayEmail displayEmail@UserEmail: Der oben genannte Benutzer/Die oben genannte Benutzerin möchte „#{displayEmail}“ als öffentliche Adresse, assoziiert mit sich selbst, angeben. Wenn Sie diese Aktion nicht selbst ausgelöst haben, ignorieren Sie diese Mitteilung bitte!
|
||||
MailTitleChangeUserDisplayEmail displayName@Text: #{displayName} möchte diese E-Mail-Adresse in FRADrive veröffentlichen
|
||||
AllocationResultsStudentConsultFaq n@Int: Falls Sie Fragen oder Anmerkungen haben, beachten Sie bitte auch die Informationen auf #{pluralDE n "der" "den"} folgenden #{pluralDE n "Seite" "Seiten"}:
|
||||
CommCourseSubject: Kursmitteilung
|
||||
InvitationAcceptDecline: Einladung annehmen/ablehnen
|
||||
InvitationFromTip displayName@Text: Sie erhalten diese Einladung, weil #{displayName} ihren Versand in FRADrive ausgelöst hat.
|
||||
|
||||
@ -15,7 +15,6 @@ ResetPassword: Reselt FRADrive password
|
||||
MailSubjectChangeUserDisplayEmail: Publishing this email address in FRADrive
|
||||
MailIntroChangeUserDisplayEmail displayEmail: The user mentioned above wants to publish “#{displayEmail}” as their own email address. If you have not caused this email to be sent, please ignore it!
|
||||
MailTitleChangeUserDisplayEmail displayName: #{displayName} wants to publish this email address as their own in FRADrive
|
||||
AllocationResultsStudentConsultFaq n@Int: If you have questions or remarks, please also take into account the information on the following #{pluralEN n "page" "pages"}:
|
||||
CommCourseSubject: Course message
|
||||
InvitationAcceptDecline: Accept/Decline invitation
|
||||
InvitationFromTip displayName: You are receiving this invitation because #{displayName} has caused it to be sent from within FRADrive.
|
||||
|
||||
@ -3,7 +3,6 @@
|
||||
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
SystemMessageLastChangedAt time@Text: Zuletzt geändert: #{time}
|
||||
NewsOpenAllocations: Offene Zentralanmeldungen
|
||||
NewsUpcomingSheets: Anstehende Übungsblätter
|
||||
NewsUpcomingExams: Bevorstehende Prüfungen
|
||||
NewsHideHiddenSystemMessages: Versteckte Nachrichten nicht mehr anzeigen
|
||||
@ -17,10 +16,4 @@ Done: Eingereicht
|
||||
SubmissionNew: Abgabe anlegen
|
||||
NoUpcomingSheetDeadlines: Keine anstehenden Übungsblätter
|
||||
NoUpcomingExams difftime@Text: In den nächsten #{difftime} gibt es keine Prüfungen oder ablaufende Prüfungsanmeldungen in Ihren Kursen
|
||||
CourseParticipant: Teilnehmer:in
|
||||
|
||||
NewsActiveAllocations: Daten zu aktiven Zentralanmeldungen für Dozenten
|
||||
NewsActiveAllocationsPlaces: Plätze
|
||||
NewsActiveAllocationsApplicants: Bewerber
|
||||
NewsActiveAllocationsPlacementsMade: Zugeteilte Plätze
|
||||
NewsActiveAllocationsApplicantsPlaced: Zugeteilte Bewerber
|
||||
CourseParticipant: Teilnehmer:in
|
||||
@ -3,7 +3,6 @@
|
||||
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
SystemMessageLastChangedAt time: Last changed: #{time}
|
||||
NewsOpenAllocations: Active central allocations
|
||||
NewsUpcomingSheets: Upcoming exercise sheets
|
||||
NewsUpcomingExams: Upcoming exams
|
||||
NewsHideHiddenSystemMessages: Don't show hidden news items
|
||||
@ -18,9 +17,3 @@ SubmissionNew: Create submission
|
||||
NoUpcomingSheetDeadlines: No upcoming sheets
|
||||
NoUpcomingExams difftime: No exams for your courses occur or allow registration in the next #{difftime}
|
||||
CourseParticipant: Participant
|
||||
|
||||
NewsActiveAllocations: Information on active allocations for lecturers
|
||||
NewsActiveAllocationsPlaces: Places
|
||||
NewsActiveAllocationsApplicants: Applicants
|
||||
NewsActiveAllocationsPlacementsMade: Placements made
|
||||
NewsActiveAllocationsApplicantsPlaced: Applicants placed
|
||||
|
||||
@ -27,7 +27,6 @@ SchoolExists ssh@SchoolId: Institut „#{ssh}“ existiert bereits
|
||||
SchoolLecturer: Dozent:in
|
||||
SchoolEvaluation: Kursumfragenverwaltung
|
||||
SchoolExamOffice: Prüfungsverwaltung
|
||||
SchoolAllocation: Zentralanmeldungs-Administration
|
||||
SchoolAdmin !ident-ok: Admin
|
||||
|
||||
SchoolAuthorshipStatementSection: Eigenständigkeitserklärungen
|
||||
|
||||
@ -28,7 +28,6 @@ SchoolAdmin: Admin
|
||||
SchoolLecturer: Lecturer
|
||||
SchoolEvaluation: Course evaluation
|
||||
SchoolExamOffice: Exam office
|
||||
SchoolAllocation: Administration of central allocations
|
||||
|
||||
SchoolAuthorshipStatementSection: Statements of Authorship
|
||||
SchoolAuthorshipStatementSheetMode: Mode for exam-unrelated exercise sheet submissions
|
||||
|
||||
@ -2,61 +2,6 @@
|
||||
#
|
||||
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
#allocation.hs + templates in scope
|
||||
MailSubjectAllocationStaffRegister allocationSchool@SchoolId allocation@AllocationName: Sie können nun Kurse für die Zentralameldung #{allocationSchool}: „#{allocation}“ registrieren
|
||||
MailSubjectAllocationStaffRegisterMultiple n@Int: Sie können nun Kurse für #{n} Zentralameldungen registrieren
|
||||
MailSubjectAllocationRegister allocationSchool@SchoolId allocation@AllocationName: Es kann sich nun für Kurse der Zentralameldung #{allocationSchool}: „#{allocation}“ beworben werden
|
||||
MailSubjectAllocationRegisterMultiple n@Int: Es kann sich nun für Kurse für #{n} Zentralanmeldungen beworben werden
|
||||
MailSubjectAllocationAllocation allocationSchool@SchoolId allocation@AllocationName: Sie können nun (optional) Bewerbungen für ihre Kurse in der Zentralanmeldung #{allocationSchool}: „#{allocation}“ bewerten
|
||||
MailSubjectAllocationAllocationMultiple n@Int: Sie können nun (optional) Bewerbungen für ihre Kurse in #{n} Zentralanmeldungen bewerten
|
||||
MailSubjectAllocationUnratedApplications allocationSchool@SchoolId allocation@AllocationName: Sie können nun (optional) Bewerbungen für ihre Kurse in der Zentralanmeldung #{allocationSchool}: „#{allocation}“ bewerten
|
||||
MailSubjectAllocationUnratedApplicationsMultiple n@Int: Sie können nun (optional) Bewerbungen für ihre Kurse in #{n} Zentralanmeldungen bewerten
|
||||
MailSubjectAllocationNewCourse allocation@AllocationName: Es wurde ein zusätzlicher Kurs zur Zentralanmeldung „#{allocation}” eingetragen
|
||||
MailSubjectAllocationResults allocation@AllocationName: Plätze für Zentralanmeldung „#{allocation}“ wurden verteilt
|
||||
AllocationResultLecturer csh@CourseShorthand count@Int64 count2@Int64: #{count} Teilnehmer:innen (von insgesamt #{count2}) für #{csh}
|
||||
AllocationResultLecturerAll csh@CourseShorthand count@Int64: #{count} Teilnehmer:innen für #{csh}
|
||||
AllocationResultLecturerNone csh@CourseShorthand: Keine Teilnehmer:innen für #{csh}
|
||||
MailAllocationStaffRegisterIntroMultiple n@Int: Sie können nun Kurse für die folgenden #{n} Zentralameldungen registrieren:
|
||||
MailAllocationStaffRegisterNewCourse: Sie können auf der unten aufgeführten Seite neue Kurse in FRADrive anlegen. Hierbei haben Sie die Möglichkeit anzugeben, dass der Kurs an einer Zentralanmeldung teilnimmt.
|
||||
MailAllocationStaffRegisterDeadline n@Int deadline@Text: Bitte beachten Sie, dass alle Kurse, die an #{pluralDE n "dieser Zentralanmeldung" "diesen Zentralanmeldungen"} teilnehmen, bis #{deadline} eingetragen sein müssen.
|
||||
MailAllocationStaffRegisterDeadlineMultiple: Bitte beachten Sie, dass alle Kurse, die an einer dieser Zentralanmeldungen teilnehmen, bis Ende der jeweiligen Regstrierungsphase (siehe unten) eingetragen sein müssen.
|
||||
MailAllocationStaffRegisterDeadlineSingle deadline@Text: Registrierungsphase endet #{deadline}
|
||||
MailAllocationStaffRegisterDeadlineSingleNothing: Aktuell kein Ende der Registrierungsphase festgelegt
|
||||
MailAllocationSchoolAndName allocationSchool@SchoolId allocation@AllocationName: #{allocationSchool}: „#{allocation}“
|
||||
CourseNew: Neuen Kurs anlegen
|
||||
MailAllocationRegisterIntroMultiple n@Int: Es kann sich nun für Kurse für die folgenden #{n} Zentralanmeldungen beworben werden:
|
||||
MailAllocationRegister n@Int: Es kann sich nun, auf #{pluralDE n "der unten aufgeführten Seite" "den unten aufgeführten Seiten"}, für alle Kurse der #{pluralDE n "Zentralanmeldung" "Zentralanmeldungen"} jeweils einzeln beworben werden.
|
||||
MailAllocationRegisterDeadline deadline@Text: Bitte beachten Sie, dass alle Bewerbungen bis #{deadline} eingegangen sein müssen.
|
||||
MailAllocationRegisterDeadlineMultiple: Bitte beachten Sie, dass alle Bewerbungen bis Ende der jeweiligen Bewerbungsphase (siehe unten) eingegangen sein müssen.
|
||||
MailAllocationRegisterDeadlineSingle deadline@Text: Bewerbungsphase endet #{deadline}
|
||||
MailAllocationRegisterDeadlineSingleNothing: Aktuell kein Ende der Bewerbungsphase festgelegt
|
||||
MailAllocationAllocationIntroMultiple n@Int: Sie können nun (optional) Bewerbungen für ihre Kurse in #{n} Zentralanmeldungen bewerten:
|
||||
MailAllocationAllocation n@Int: Sie können nun auf den unten aufgeführten Seiten Bewerbungen, die im Rahmen der #{pluralDE n "Zentralanmeldung" "Zentralanmeldungen"} an ihre Kurse gestellt wurden, bewerten. Die Bewertungen werden bei der Vergabe der Plätze berücksichtigt.
|
||||
MailAllocationApplicationsMayChange deadline@Text: Bitte beachten Sie, dass Studierende noch bis #{deadline} Bewerbungen stellen, verändern und zurückziehen können. Bewerbungen, die sich nach ihrer Bewertung noch verändern, müssen neu bewertet werden.
|
||||
MailAllocationApplicationsRegisterDeadline deadline@Text: Bewerbungsphase endet #{deadline}
|
||||
MailAllocationApplicationsRegisterDeadlineNothing: Aktuell kein Ende der Bewerbungsphase festgelegt
|
||||
MailAllocationApplicationsMayChangeMultiple: Bitte beachten Sie, dass Studierende noch bis Ende der Bewerbungsphase (siehe unten) der jeweiligen Zentralanmeldung Bewerbungen stellen, verändern und zurückziehen können. Bewerbungen, die sich nach ihrer Bewertung noch verändern, müssen neu bewertet werden.
|
||||
MailAllocationAllocationDeadline deadline@Text: Bitte beachten Sie, dass alle Bewertungen bis #{deadline} erfolgt sein müssen.
|
||||
MailAllocationApplicationsAllocationDeadline deadline@Text: Bewertungsphase endet #{deadline}
|
||||
MailAllocationApplicationsAllocationDeadlineNothing: Aktuell keine Ende der Bewertungsphase festgelegt
|
||||
MailAllocationAllocationDeadlineMultiple: Bitte beachten Sie, dass alle Bewertungen bis Ende der Bewertungsphase (siehe unten) erfolgt sein müssen.
|
||||
MailAllocationUnratedApplicationsIntroMultiple n@Int: Sie können nun (optional) Bewerbungen für ihre Kurse in #{n} Zentralanmeldungen bewerten:
|
||||
MailAllocationUnratedApplications n@Int: Für die unten aufgeführten Kurse liegen Bewerbungen vor, die im Rahmen der #{pluralDE n "Zentralanmeldung" "Zentralanmeldungen"} an den jeweiligen Kurs gestellt wurden, die entweder noch nicht bewertet wurden oder die nach der Bewertung noch verändert wurden, sodass die vorhandenen Bewertungen nun nicht mehr gültig sind.
|
||||
MailAllocationUnratedApplicationsRatingIsOptional: Es steht Ihnen frei so viele oder so wenige Bewerbungen zu bewerten, wie Sie möchten (Sie können auch garkeine Bewerbungen bewerten).
|
||||
MailAllocationUnratedApplicationsCount i@Natural: #{i} #{pluralDE i "Bewerbung" "Bewerbungen"}
|
||||
AllocationResultsLecturer: Im Rahmen der oben genannten Zentralanmeldung wurden Plätze zugewiesen, wie folgt:
|
||||
AllocationResultsLecturerSubstituteCoursesWarning: Bitte konfigurieren Sie so bald wie möglich einen Zeitrahmen in dem Sie bereit sind etwaige Nachrücker in den folgenden Kursen zu akzeptieren:
|
||||
AllocationResultsStudent: Sie haben Plätze erhalten in:
|
||||
AllocationNoResultsStudent: Sie haben leider keine Plätze erhalten.
|
||||
AllocationResultStudent csh@CourseShorthand: Sie haben einen Platz in #{csh} erhalten.
|
||||
AllocationResultsTip: Die folgenden Informationen entsprechen dem aktuellen Stand der Zentralanmeldung und können sich, z.B. durch die Verteilung von Plätzen an Nachrücker, noch ändern. Über zukünftige Änderungen, die Sie betreffen, werden Sie gesondert informiert.
|
||||
AllocationResultsStudentTip: Unten aufgeführt sind alle Plätze, die Sie im Rahmen der genannten Zentralanmeldung erhalten haben und von denen Sie seit dem weder abgemeldet wurden, noch sich selbst abgemeldet haben. Plätze, über die Sie ggf. bereits informiert wurden, können also erneut aufgeführt sein.
|
||||
AllocationResultStudentRegistrationTip: Sie sind zu oben genanntem Kurs in FRADrive angemeldet.
|
||||
AllocationResultsStudentRegistrationTip: Sie sind zu den oben genannten Kursen in FRADrive angemeldet.
|
||||
MailAllocationNewCourseTip: Es wurde der folgende Kurs zur Zentralanmeldung eingetragen:
|
||||
MailAllocationNewCourseEditApplicationsHere: Sie können Ihre Bewerbung(en) hier anpassen:
|
||||
MailAllocationNewCourseApplyHere: Sie können sich hier bewerben:
|
||||
|
||||
#correctionsAssigned.hs + templates
|
||||
MailSubjectCorrectionsAssigned csh@CourseShorthand sheetName@SheetName: Ihnen wurden Korrekturen zu #{sheetName} in #{csh} zugeteilt
|
||||
MailCorrectionsAssignedIntro courseName@Text termDesc@Text sheetName@SheetName n@Int: #{n} #{pluralDE n "Abgabe wurde" "Abgaben wurden"} Ihnen zur Korrektur für #{sheetName} im Kurs #{courseName} (#{termDesc}) zugeteilt.
|
||||
|
||||
@ -2,61 +2,6 @@
|
||||
#
|
||||
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
#allocation.hs + templates in scope
|
||||
MailSubjectAllocationStaffRegister allocationSchool allocation: You can now register courses for the central allocation #{allocationSchool}: “#{allocation}”
|
||||
MailSubjectAllocationStaffRegisterMultiple n: You can now register courses for #{n} central allocations
|
||||
MailSubjectAllocationRegister allocationSchool allocation: Applications can now be made for courses of the central allocation #{allocationSchool}: “#{allocation}”
|
||||
MailSubjectAllocationRegisterMultiple n: Applications can now be made for courses of #{n} central allocations
|
||||
MailSubjectAllocationAllocation allocationSchool allocation: You can now (optionally) rate applications for your courses that participate in the central allocation #{allocationSchool}: “#{allocation}”
|
||||
MailSubjectAllocationAllocationMultiple n: You can now (optionally) rate applications for your courses that participate in #{n} central allocations
|
||||
MailSubjectAllocationUnratedApplications allocationSchool allocation: You can now (optionally) rate applications for your courses that participate in the central allocation #{allocationSchool}: “#{allocation}”
|
||||
MailSubjectAllocationUnratedApplicationsMultiple n: You can now (optionally) rate applications for your courses that participate in #{n} central allocations
|
||||
MailSubjectAllocationNewCourse allocation: A new course was added to the central allocation “#{allocation}”
|
||||
AllocationResultLecturer csh count count2: #{count} #{pluralEN count "participant" "participants"} (of #{count2}) for #{csh}
|
||||
AllocationResultLecturerAll csh count: #{count} #{pluralEN count "participant" "participants"} for #{csh}
|
||||
AllocationResultLecturerNone csh: No participants for #{csh}
|
||||
MailAllocationStaffRegisterIntroMultiple n: You can now register courses for the following #{n} central allocations:
|
||||
MailAllocationStaffRegisterNewCourse: You can create new courses in FRADrive on the site listed below. While doing so you can specify that the course should participate in a central allocation.
|
||||
MailAllocationStaffRegisterDeadline n deadline: Please consider that all courses, that are to participate in #{pluralEN n "this central allocation" "these central allocations"}, must be registered before #{deadline}.
|
||||
MailAllocationStaffRegisterDeadlineMultiple: Please consider that alle courses, that are to participate in these central allocations, must be registered before the ends of their respective course registration periods (see below).
|
||||
MailAllocationStaffRegisterDeadlineSingle deadline: Course Registration period ends on #{deadline}
|
||||
MailAllocationStaffRegisterDeadlineSingleNothing: Currently no end of course registration period configured
|
||||
MailAllocationSchoolAndName allocationSchool allocation: #{allocationSchool}: “#{allocation}”
|
||||
CourseNew: Create new course
|
||||
MailAllocationRegisterIntroMultiple n: Applications can now be made for courses of the following #{n} central allocations:
|
||||
MailAllocationRegister n: Applications can now be made for each of the courses participating in the central #{pluralEN n "allocation" "allocations"} on the #{pluralEN n "page" "pages"} listed below.
|
||||
MailAllocationRegisterDeadline deadline: Please consider that all applications have to be made before #{deadline}.
|
||||
MailAllocationRegisterDeadlineMultiple: Please consider that all applications for courses participating in central allocations have to be made before the ends of their respective application periods (see below).
|
||||
MailAllocationRegisterDeadlineSingle deadline: Application periods ends on #{deadline}
|
||||
MailAllocationRegisterDeadlineSingleNothing: Currently no end of application period configured
|
||||
MailAllocationAllocationIntroMultiple n: You can now (optionally) rate applications for your courses that participate in #{n} central allocations:
|
||||
MailAllocationAllocation n: You can now rate applications made in the context of the central #{pluralEN n "allocation" "allocations"} for your courses on the pages listed below. Ratings made will have an effect on the allocation.
|
||||
MailAllocationApplicationsMayChange deadline: Please consider that applicants may change or delete their applications until #{deadline}. If an application was rated before it was changed it needs to be rated again.
|
||||
MailAllocationApplicationsRegisterDeadline deadline: Application period ends on #{deadline}
|
||||
MailAllocationApplicationsRegisterDeadlineNothing: Currently no end of application period configured
|
||||
MailAllocationApplicationsMayChangeMultiple: Please consider that applicants may change or delete their applications until the end of the respective central allocation's application period. If an application was rated before it was changed it needs to be rated again.
|
||||
MailAllocationAllocationDeadline deadline: Please consider that all ratings have to be made before #{deadline}.
|
||||
MailAllocationApplicationsAllocationDeadline deadline: Rating period ends on #{deadline}
|
||||
MailAllocationApplicationsAllocationDeadlineNothing: Currently no end of rating period configured
|
||||
MailAllocationAllocationDeadlineMultiple: Please consider that all ratings have to be made before the end of the respective rating period (see below).
|
||||
MailAllocationUnratedApplicationsIntroMultiple n: You can now (optionally) rate applications for your courses that participate in #{n} central allocations:
|
||||
MailAllocationUnratedApplications n: For there courses listed below, there exist applications made in the context of #{pluralEN n "the central allocation" "one of the central allocations"} which have either not yet been rated or which have changed since they were rated.
|
||||
MailAllocationUnratedApplicationsRatingIsOptional: You are free to rate as many or as few applications as you want to (you may also rate none of them).
|
||||
MailAllocationUnratedApplicationsCount i: #{i} #{pluralDE i "application" "applications"}
|
||||
MailSubjectAllocationResults allocation: Placements have been made for the central allocation “#{allocation}”
|
||||
AllocationResultsLecturer: In the course of the central allocations placements have been made as follows:
|
||||
AllocationResultsLecturerSubstituteCoursesWarning: Please configure a deadline up to which you are able to accept substitute registrations for the following courses as soon as possible:
|
||||
AllocationResultsStudent: You have been placed in:
|
||||
AllocationNoResultsStudent: Unfortunately you were not placed in any courses.
|
||||
AllocationResultStudent csh: You were placed in #{csh}.
|
||||
AllocationResultsTip: The following information reflect the current state of the allocation and are subject to change (e.g. when handling succession). You will be informed separately if any future changes concern you.
|
||||
AllocationResultsStudentTip: Listed below are placements in courses which you have received due to the mentioned central allocation and for which you have not left the respective course or have been deregistered. Thus placements you have been informed of already may be listed again.
|
||||
AllocationResultStudentRegistrationTip: You were enrolled in the course mentioned above in FRADrive.
|
||||
AllocationResultsStudentRegistrationTip: You were enrolled in the courses mentioned above in FRADrive.
|
||||
MailAllocationNewCourseTip: The following course was added to the central allocation:
|
||||
MailAllocationNewCourseEditApplicationsHere: You can modify your application here:
|
||||
MailAllocationNewCourseApplyHere: You can apply here:
|
||||
|
||||
#correctionsAssigned.hs + templates
|
||||
MailSubjectCorrectionsAssigned csh sheetName: You were assigned corrections for #{sheetName} of #{csh}
|
||||
MailCorrectionsAssignedIntro courseName termDesc sheetName n: You were assigned #{n} #{pluralEN n "correction" "corrections"} for #{sheetName} of #{courseName} (#{termDesc}).
|
||||
|
||||
@ -16,7 +16,6 @@ AuthTagSystemExamOffice: Nutzer:in ist mit systemweiter Prüfungsverwaltung beau
|
||||
AuthTagSystemPrinter: Nutzer:in ist mit systemweiten Druck von Briefen beauftragt
|
||||
AuthTagSystemSap: Nutzer:in ist mit systemweiter SAP Schnittstellen-Administration beauftragt
|
||||
AuthTagEvaluation: Nutzer:in ist mit Kursumfragenverwaltung beauftragt
|
||||
AuthTagAllocationAdmin: Nutzer:in ist mit der Administration von Zentralanmeldungen beauftragt
|
||||
AuthTagToken: Nutzer:in präsentiert Authorisierungs-Token
|
||||
AuthTagNoEscalation: Nutzer-Rechte werden nicht auf fremde Institute ausgeweitet
|
||||
AuthTagDeprecated: Seite ist nicht überholt
|
||||
@ -28,17 +27,14 @@ AuthTagTutor: Nutzer:in ist Tutor:in
|
||||
AuthTagTutorControl: Tutorierende haben Kontrolle über ihre Tutorium
|
||||
AuthTagTime: Zeitliche Einschränkungen sind erfüllt
|
||||
AuthTagStaffTime: Zeitliche Einschränkungen für Lehrbeteiligte sind erfüllt
|
||||
AuthTagAllocationTime: Zeitliche Einschränkungen durch Zentralanmeldung sind erfüllt
|
||||
AuthTagCourseTime: Zeitliche Einschränkungen für Kurssichtbarkeit sind erfüllt
|
||||
AuthTagCourseRegistered: Nutzer:in ist Kursteilnehmer:in
|
||||
AuthTagAllocationRegistered: Nutzer:in nimmt an der Zentralanmeldung teil
|
||||
AuthTagTutorialRegistered: Nutzer:in ist Tutoriumsteilnehmer:in
|
||||
AuthTagExamRegistered: Nutzer:in ist Prüfungsteilnehmer:in
|
||||
AuthTagExamResult: Nutzer:in hat Prüfungsergebnisse
|
||||
AuthTagExamOccurrenceRegistered: Nutzer:in ist für Prüfungsraum/-termin angemeldet
|
||||
AuthTagExamOccurrenceRegistration: Anmeldung zur Prüfung erfolgt inkl. Raum/Termin
|
||||
AuthTagParticipant: Nutzer:in ist mit Kurs assoziiert
|
||||
AuthTagApplicant: Nutzer:in ist mit Bewerber zum Kurs
|
||||
AuthTagRegisterGroup: Nutzer:in ist nicht Mitglied eines anderen Tutoriums mit der selben Registrierungs-Gruppe
|
||||
AuthTagCapacity: Kapazität ist ausreichend
|
||||
AuthTagEmpty: Ressource ist „leer“
|
||||
|
||||
@ -16,7 +16,6 @@ AuthTagSystemExamOffice: User is charged with system wide exam administration
|
||||
AuthTagSystemPrinter: User is responsible for system wide letter printing
|
||||
AuthTagSystemSap: User is responsible for system wide SAP interface administration
|
||||
AuthTagEvaluation: User is charged with course evaluation
|
||||
AuthTagAllocationAdmin: User is charged with administration of central allocations
|
||||
AuthTagToken: User is presenting an authorisation-token
|
||||
AuthTagNoEscalation: User permissions are not being expanded to other departments
|
||||
AuthTagDeprecated: Page is not deprecated
|
||||
@ -28,17 +27,14 @@ AuthTagTutor: User is tutor
|
||||
AuthTagTutorControl: Tutors have control over their tutorial
|
||||
AuthTagTime: Time restrictions are fulfilled
|
||||
AuthTagStaffTime: Time restrictions for teaching staff are fulfilled
|
||||
AuthTagAllocationTime: Time restrictions due to a central allocation are fulfilled
|
||||
AuthTagCourseTime: Time restrictions for course visibility are fulfilled
|
||||
AuthTagCourseRegistered: User is enrolled in course
|
||||
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
|
||||
AuthTagCapacity: Capacity is sufficient
|
||||
AuthTagEmpty: Resource is “empty”
|
||||
|
||||
@ -57,10 +57,7 @@ NotificationTriggerKindCourseLecturer: Für Kursverwalter:innen
|
||||
NotificationTriggerKindAdmin: Für Administrator:innen
|
||||
NotificationTriggerKindExamOffice: Für Prüfungsverwalter:innen
|
||||
NotificationTriggerKindEvaluation: Für Vorlesungsumfragen
|
||||
NotificationTriggerKindAllocationStaff: Für Zentralanmeldungen (Dozierende)
|
||||
NotificationTriggerKindAllocationParticipant: Für Zentralanmeldungen
|
||||
NotificationTriggerKindSubmissionUser: Für Mitabgebende einer Übungsblatt-Abgabe
|
||||
NotificationTriggerKindAllocationAdmin: Für Administrator:innen von Zentralanmeldungen
|
||||
|
||||
NotificationTriggerSubmissionRatedGraded: Meine Abgabe in einem gewerteten Übungsblatt wurde korrigiert
|
||||
NotificationTriggerSubmissionRated: Meine Abgabe wurde korrigiert
|
||||
@ -77,20 +74,12 @@ NotificationTriggerExamRegistrationActive: Ich kann mich für eine Prüfung anme
|
||||
NotificationTriggerExamRegistrationSoonInactive: Ich kann mich bald nicht mehr für eine Prüfung anmelden
|
||||
NotificationTriggerExamDeregistrationSoonInactive: Ich kann mich bald nicht mehr von einer Prüfung abmelden
|
||||
NotificationTriggerExamResult: Ich kann ein neues Prüfungsergebnis einsehen
|
||||
NotificationTriggerAllocationStaffRegister: Ich kann Kurse bei einer neuen Zentralanmeldung eintragen
|
||||
NotificationTriggerAllocationAllocation: Ich kann Zentralanmeldungs-Bewerbungen für einen meiner Kurse bewerten
|
||||
NotificationTriggerAllocationRegister: Ich kann mich bei einer neuen Zentralanmeldung bewerben
|
||||
NotificationTriggerAllocationOutdatedRatings: Zentralanmeldungs-Bewerbungen für einen meiner Kurse wurden verändert, nachdem sie bewertet wurden
|
||||
NotificationTriggerAllocationUnratedApplications: Bewertungen zu Zentralanmeldungs-Bewerbungen für einen meiner Kurse stehen aus
|
||||
NotificationTriggerAllocationResults: Plätze wurden für eine meiner Zentralanmeldungen verteilt
|
||||
NotificationTriggerExamOfficeExamResults: Ich kann neue Prüfungsergebnisse einsehen
|
||||
NotificationTriggerExamOfficeExamResultsChanged: Prüfungsergebnisse wurden verändert
|
||||
NotificationTriggerCourseRegistered: Ein:e Kursverwalter:in hat mich zu einem Kurs angemeldet
|
||||
NotificationTriggerSubmissionUserCreated: Ich wurde als Mitabgebender zu einer Übungsblatt-Abgabe hinzugefügt
|
||||
NotificationTriggerSubmissionEdited: Eine meiner Übungsblatt-Abgaben wurde verändert
|
||||
NotificationTriggerSubmissionUserDeleted: Ich wurde als Mitabgebender von einer Übungsblatt-Abgabe entfernt
|
||||
NotificationTriggerAllocationNewCourse: Es wurde ein neuer Kurs eingetragen zu einer Zentralanmeldungen, zu der ich meine Teilnahme registriert habe
|
||||
NotificationTriggerAllocationNewCourseTip: Kann pro Zentralanmeldung überschrieben werden
|
||||
NotificationTriggerQualification: Eine meiner Qualifikationen läuft ab
|
||||
|
||||
UserDisplayNameRules: Vorgaben für den angezeigten Namen
|
||||
@ -113,8 +102,6 @@ FavouritesPlaceholder: Anzahl Favoriten
|
||||
FavouritesNotNatural: Anzahl der Favoriten muss eine natürliche Zahl sein!
|
||||
FavouritesSemestersPlaceholder: Anzahl Semester
|
||||
FavouritesSemestersNotNatural: Anzahl der Favoriten-Semester muss eine natürliche Zahl sein!
|
||||
FormAllocationNotifications: Benachrichtigungen für neue Zentralanmeldungskurse
|
||||
FormAllocationNotificationsTip: Wollen Sie eine Benachrichtigung per E-Mail erhalten wenn ein neuer Kurs zur Zentralanmeldung eingetragen wird? „Ja“ und „Nein“ überschreiben die entsprechende systemweite Einstellung unter "Benachrichtigungen"
|
||||
SettingsUpdate: Einstellungen erfolgreich gespeichert
|
||||
TokensResetSuccess: Authorisierungs-Tokens invalidiert
|
||||
ProfileTitle: Benutzereinstellungen
|
||||
@ -125,9 +112,6 @@ LastEditByUser: Ihre letzte Bearbeitung
|
||||
SubmissionGroupName: Gruppenname
|
||||
TitleChangeUserDisplayEmail: Öffentliche E-Mail-Adresse setzen
|
||||
LanguageChanged: Sprache erfolgreich geändert
|
||||
AllocNotifyNewCourseDefault: Systemweite Einstellung
|
||||
AllocNotifyNewCourseForceOff: Nein
|
||||
AllocNotifyNewCourseForceOn: Ja
|
||||
Settings: Individuelle Benutzereinstellungen
|
||||
|
||||
FormExamOffice: Prüfungsverwaltung
|
||||
|
||||
@ -57,10 +57,7 @@ NotificationTriggerKindCourseLecturer: For course administrators
|
||||
NotificationTriggerKindAdmin: For administrators
|
||||
NotificationTriggerKindExamOffice: For the exam office
|
||||
NotificationTriggerKindEvaluation: For course evaluations
|
||||
NotificationTriggerKindAllocationStaff: For central allocations (lecturers)
|
||||
NotificationTriggerKindAllocationParticipant: For central allocations
|
||||
NotificationTriggerKindSubmissionUser: For participants in an exercise sheet submission
|
||||
NotificationTriggerKindAllocationAdmin: For administrators of central allocations
|
||||
|
||||
NotificationTriggerSubmissionRatedGraded: My submission for an exercise sheet was marked (not purely informational)
|
||||
NotificationTriggerSubmissionRated: My submission for an exercise sheet was marked
|
||||
@ -77,20 +74,12 @@ NotificationTriggerExamRegistrationActive: I can now register for an exam
|
||||
NotificationTriggerExamRegistrationSoonInactive: I will soon no longer be able to register for an exam
|
||||
NotificationTriggerExamDeregistrationSoonInactive: I will soon no longer be able to deregister from an exam
|
||||
NotificationTriggerExamResult: An exam result is available
|
||||
NotificationTriggerAllocationStaffRegister: I can now register a course for central allocation
|
||||
NotificationTriggerAllocationAllocation: I can now grade applications to a central alloction for one of my courses
|
||||
NotificationTriggerAllocationRegister: I can now apply to a new central allocation
|
||||
NotificationTriggerAllocationOutdatedRatings: Applications to a central allocation for one of my courses have changed since they were graded
|
||||
NotificationTriggerAllocationUnratedApplications: Grades are pending for applications to a central allocation for one of my courses
|
||||
NotificationTriggerAllocationResults: Participants have been placed by one of my central allocations
|
||||
NotificationTriggerExamOfficeExamResults: New exam results are available
|
||||
NotificationTriggerExamOfficeExamResultsChanged: Exam results have changed
|
||||
NotificationTriggerCourseRegistered: A course administrator has enrolled me in a course
|
||||
NotificationTriggerSubmissionUserCreated: I was added to an exercise sheet submission
|
||||
NotificationTriggerSubmissionEdited: One of my exercise sheet submissions was changed
|
||||
NotificationTriggerSubmissionUserDeleted: I was removed from one of my exercise sheet submissions
|
||||
NotificationTriggerAllocationNewCourse: A new course was added to a central allocation for which I have registered my participation
|
||||
NotificationTriggerAllocationNewCourseTip: Can be overridden per central allocation
|
||||
NotificationTriggerQualification: My Qualifications are about to expire
|
||||
|
||||
UserDisplayNameRules: Specification for display names
|
||||
@ -113,8 +102,6 @@ FavouritesPlaceholder: Number of favourites
|
||||
FavouritesNotNatural: Number of favourites must be a natural number!
|
||||
FavouritesSemestersPlaceholder: Number of semesters
|
||||
FavouritesSemestersNotNatural: Maximum number of semesters in favourites bar must be a natural number!
|
||||
FormAllocationNotifications: Notifications for new central allocation courses
|
||||
FormAllocationNotificationsTip: Do you want to receive a notification if a new course is added to the central allocation? “Yes” and “No” override the system wide setting under “Notifications”
|
||||
SettingsUpdate: Successfully updated settings
|
||||
TokensResetSuccess: Successfully invalidated all authorisation tokens
|
||||
ProfileTitle: Settings
|
||||
@ -125,10 +112,6 @@ LastEditByUser: Your last edit
|
||||
SubmissionGroupName: Group name
|
||||
TitleChangeUserDisplayEmail: Set display email
|
||||
LanguageChanged: Language changed successfully
|
||||
|
||||
AllocNotifyNewCourseDefault: System-wide setting
|
||||
AllocNotifyNewCourseForceOff: No
|
||||
AllocNotifyNewCourseForceOn: Yes
|
||||
Settings: Settings
|
||||
|
||||
FormExamOffice: Exam Office
|
||||
@ -9,8 +9,6 @@ BtnRegister: Anmelden
|
||||
BtnDeregister: Abmelden
|
||||
BtnCourseRegister: Zum Kurs anmelden
|
||||
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
|
||||
BtnExamSwitchOccurrence: Zu Prüfungstermin/-raum wechseln
|
||||
@ -32,20 +30,10 @@ BtnCorrInvAccept: Annehmen
|
||||
BtnCorrInvDecline: Ablehnen
|
||||
BtnSubmissionsAssign: Abgaben automatisch zuteilen
|
||||
BtnSubmissionsAssignAll: Abgaben automatisch zuteilen
|
||||
BtnAllocationCompute: Vergabe berechnen
|
||||
BtnAllocationAccept: Vergabe akzeptieren
|
||||
BtnAllocationRegister: Teilnahme registrieren
|
||||
BtnAllocationRegistrationEdit: Teilnahme anpassen
|
||||
BtnAllocationApply: Bewerben
|
||||
BtnAllocationApplicationEdit: Bewerbung ersetzen
|
||||
BtnAllocationApplicationRetract: Bewerbung zurückziehen
|
||||
BtnAllocationApplicationRate: Bewerbung bewerten
|
||||
BtnSystemMessageHide: Verstecken
|
||||
BtnSystemMessageUnhide: Nicht mehr verstecken
|
||||
BtnCommunicationSend: Senden
|
||||
BtnCommunicationTest: Test-Nachricht verschicken
|
||||
BtnAcceptApplications: Bewerbungen akzeptieren
|
||||
BtnAcceptApplicationsTip: Mit dem untigen Knopf können Sie den Kurs (höchstens bis zur angegeben Maximalkapazität, falls eingestellt) mit Bewerbern auffüllen. Die Bewertungen der Bewerbungen werden dabei berücksichtigt (Unbewertet wird behandelt wie eine Note zwischen 2.3 und 2.7). Bewerber mit Veto oder 5.0 werden nicht angemeldet.
|
||||
BtnExamAutoOccurrenceCalculate: Verteilungstabelle berechnen
|
||||
BtnExamAutoOccurrenceAccept: Verteilung akzeptieren
|
||||
BtnExamAutoOccurrenceNudgeUp !ident-ok: +
|
||||
|
||||
@ -9,8 +9,6 @@ BtnRegister: Register
|
||||
BtnDeregister: Deregister
|
||||
BtnCourseRegister: Enrol for course
|
||||
BtnCourseDeregister: Leave course
|
||||
BtnCourseApply: Apply for course
|
||||
BtnCourseRetractApplication: Retract application
|
||||
BtnExamRegister: Enrol for exam
|
||||
BtnExamRegisterOccurrence: Enrol for exam occurrence/room
|
||||
BtnExamSwitchOccurrence: Switch to exam occurrence/room
|
||||
@ -32,20 +30,10 @@ BtnCorrInvAccept: Accept
|
||||
BtnCorrInvDecline: Decline
|
||||
BtnSubmissionsAssign: Assign submissions automatically
|
||||
BtnSubmissionsAssignAll: Automatically distribute corrections
|
||||
BtnAllocationCompute: Compute allocation
|
||||
BtnAllocationAccept: Accept allocation
|
||||
BtnAllocationRegister: Register participation
|
||||
BtnAllocationRegistrationEdit: Edit registration
|
||||
BtnAllocationApply: Apply
|
||||
BtnAllocationApplicationEdit: Edit application
|
||||
BtnAllocationApplicationRetract: Retract application
|
||||
BtnAllocationApplicationRate: Grade application
|
||||
BtnSystemMessageHide: Hide
|
||||
BtnSystemMessageUnhide: Unhide
|
||||
BtnCommunicationSend: Send
|
||||
BtnCommunicationTest: Send test message
|
||||
BtnAcceptApplications: Accept applications
|
||||
BtnAcceptApplicationsTip: By clicking the button below you may fill the course with applicants (only up to the maximum capacity if configured). Grading of applications will be considered (no grading is treated as if graded between 2.3 and 2.7). Vetoed applicants and applications graded 5.0 will not be enrolled.
|
||||
BtnInviteAccept: Accept invitation
|
||||
BtnInviteDecline: Decline invitation
|
||||
BtnExamAutoOccurrenceCalculate: Calculate assignment rules
|
||||
|
||||
@ -6,24 +6,15 @@ BreadcrumbCsvOptions: CSV-Optionen
|
||||
BreadcrumbSubmissionFile: Datei
|
||||
BreadcrumbSubmissionUserInvite: Einladung zur Abgabe
|
||||
BreadcrumbCryptoIDDispatch: CryptoID-Weiterleitung
|
||||
BreadcrumbCourseAppsFiles: Bewerbungsdateien
|
||||
BreadcrumbCourseNotes: Kursnotizen
|
||||
BreadcrumbHiWis: Korrektor:innen
|
||||
BreadcrumbMaterial !ident-ok: Material
|
||||
BreadcrumbSheet: Übungsblatt
|
||||
BreadcrumbTutorial: Tutorium
|
||||
BreadcrumbExam: Prüfung
|
||||
BreadcrumbApplicant: Bewerber:in
|
||||
BreadcrumbCourseRegister: Anmelden
|
||||
BreadcrumbCourseRegisterTemplate: Bewerbungsvorlagen
|
||||
BreadcrumbCourseFavourite: Favorisieren
|
||||
BreadcrumbCourse: Kurs
|
||||
BreadcrumbAllocationRegister: Teilnahme registrieren
|
||||
BreadcrumbAllocation: Zentralanmeldung
|
||||
BreadcrumbAllocationNew: Neue Zentralanmeldung
|
||||
BreadcrumbAllocationEdit: Bearbeiten
|
||||
BreadcrumbAllocationMatchings: Verteilungen
|
||||
BreadcrumbAllocationMatchingLog: Verteilungs-Protokoll
|
||||
BreadcrumbTerm !ident-ok: Semester
|
||||
BreadcrumbSchool: Institut
|
||||
BreadcrumbUser: Benutzer:in
|
||||
@ -41,7 +32,6 @@ BreadcrumbCourseNews: Kursnachricht
|
||||
BreadcrumbCourseNewsDelete: Kursnachricht löschen
|
||||
BreadcrumbCourseEventDelete: Kurstermin löschen
|
||||
BreadcrumbProfile: Einstellungen
|
||||
BreadcrumbAllocationInfo: Ablauf einer Zentralanmeldung
|
||||
BreadcrumbCourseParticipantInvitation: Einladung als Kursteilnehmer:in
|
||||
BreadcrumbMaterialArchive: Archiv
|
||||
BreadcrumbMaterialFile: Datei
|
||||
@ -56,7 +46,6 @@ BreadcrumbTutorInvite: Einladung als Tutor:in
|
||||
BreadcrumbExamCorrectorInvite: Einladung als Prüfungskorrektor:in
|
||||
BreadcrumbExamParticipantInvite: Einladung als Prüfungsteilnehmer:in
|
||||
BreadcrumbExamRegister: Anmelden
|
||||
BreadcrumbApplicationFiles: Bewerbungsdateien
|
||||
BreadcrumbCourseNewsArchive: Archiv
|
||||
BreadcrumbCourseNewsFile: Datei
|
||||
BreadcrumbExternalExam: Externe Prüfung
|
||||
@ -72,13 +61,6 @@ BreadcrumbParticipantsList: Kursteilnehmerlisten
|
||||
BreadcrumbParticipants: Kursteilnehmerliste
|
||||
BreadcrumbExamAutoOccurrence: Automatische Termin-/Raumverteilung
|
||||
BreadcrumbStorageKey: Lokalen Schlüssel generieren
|
||||
BreadcrumbAllocationUsers: Bewerber:innen
|
||||
BreadcrumbAllocationPriorities: Zentrale Dringlichkeiten
|
||||
BreadcrumbAllocationCompute: Platzvergabe berechnen
|
||||
BreadcrumbAllocationAccept: Platzvergabe akzeptieren
|
||||
BreadcrumbAllocationAddUser: Bewerber:in hinzufügen
|
||||
BreadcrumbAllocationEditUser: Bewerber:in bearbeiten
|
||||
BreadcrumbAllocationDelUser: Bewerber:in entfernen
|
||||
BreadcrumbMessageHide: Verstecken
|
||||
BreadcrumbFaq !ident-ok: FAQ
|
||||
BreadcrumbSheetPersonalisedFiles: Personalisierte Dateien herunterladen
|
||||
@ -113,7 +95,6 @@ BreadcrumbTermShow: Semester
|
||||
BreadcrumbTermCreate: Neues Semester anlegen
|
||||
BreadcrumbTermEdit: Semester editieren
|
||||
BreadcrumbTermCurrent: Aktuelles Semester
|
||||
BreadcrumbAllocationListTitle: Zentralanmeldungen
|
||||
BreadcrumbParticipantsIntersect: Überschneidung von Kursteilnehmer:innen
|
||||
BreadcrumbCourseList: Kurse
|
||||
BreadcrumbCourseNew: Neuen Kurs anlegen
|
||||
@ -136,7 +117,6 @@ BreadcrumbCourseEventNew: Neuer Kurstermin
|
||||
BreadcrumbCourseEventEdit: Kurstermin bearbeiten
|
||||
BreadcrumbExamList: Prüfungen
|
||||
BreadcrumbExamNew: Neue Prüfung anlegen
|
||||
BreadcrumbCourseApplications: Bewerbungen
|
||||
BreadcrumbExamEdit: Prüfung bearbeiten
|
||||
BreadcrumbExamUsers: Teilnehmer:innen
|
||||
BreadcrumbExamGrades: Prüfungsleistungen
|
||||
|
||||
@ -6,24 +6,15 @@ BreadcrumbCsvOptions: csv-options
|
||||
BreadcrumbSubmissionFile: File
|
||||
BreadcrumbSubmissionUserInvite: Invitation to participate in a submission
|
||||
BreadcrumbCryptoIDDispatch: CryptoID-redirect
|
||||
BreadcrumbCourseAppsFiles: Application files
|
||||
BreadcrumbCourseNotes: Course notes
|
||||
BreadcrumbHiWis: Correctors
|
||||
BreadcrumbMaterial: Material
|
||||
BreadcrumbSheet: Exercise sheet
|
||||
BreadcrumbTutorial: Tutorial
|
||||
BreadcrumbExam: Exam
|
||||
BreadcrumbApplicant: Applicant
|
||||
BreadcrumbCourseRegister: Register
|
||||
BreadcrumbCourseRegisterTemplate: Application template
|
||||
BreadcrumbCourseFavourite: Favourite
|
||||
BreadcrumbCourse: Course
|
||||
BreadcrumbAllocationRegister: Register participation
|
||||
BreadcrumbAllocation: Central allocation
|
||||
BreadcrumbAllocationNew: New Allocation
|
||||
BreadcrumbAllocationEdit: Edit
|
||||
BreadcrumbAllocationMatchings: Matchings
|
||||
BreadcrumbAllocationMatchingLog: Matching log
|
||||
BreadcrumbTerm: Semester
|
||||
BreadcrumbSchool: Department
|
||||
BreadcrumbUser: User
|
||||
@ -41,7 +32,6 @@ BreadcrumbCourseNews: Course news
|
||||
BreadcrumbCourseNewsDelete: Delete course news
|
||||
BreadcrumbCourseEventDelete: Delete course occurrence
|
||||
BreadcrumbProfile: Settings
|
||||
BreadcrumbAllocationInfo: On central allocations
|
||||
BreadcrumbCourseParticipantInvitation: Invitation to be a course participant
|
||||
BreadcrumbMaterialArchive: Archive
|
||||
BreadcrumbMaterialFile: File
|
||||
@ -56,7 +46,6 @@ BreadcrumbTutorInvite: Invitation to be a tutor
|
||||
BreadcrumbExamCorrectorInvite: Invitation to be an exam corrector
|
||||
BreadcrumbExamParticipantInvite: Invitation to be an exam participant
|
||||
BreadcrumbExamRegister: Register
|
||||
BreadcrumbApplicationFiles: Application files
|
||||
BreadcrumbCourseNewsArchive: Archive
|
||||
BreadcrumbCourseNewsFile: File
|
||||
BreadcrumbExternalExam: External exam
|
||||
@ -72,13 +61,6 @@ BreadcrumbParticipantsList: Lists of course participants
|
||||
BreadcrumbParticipants: Course participants
|
||||
BreadcrumbExamAutoOccurrence: Automatic occurrence/room distribution
|
||||
BreadcrumbStorageKey: Generate storage key
|
||||
BreadcrumbAllocationUsers: Applicants
|
||||
BreadcrumbAllocationPriorities: Central priorities
|
||||
BreadcrumbAllocationCompute: Compute allocation
|
||||
BreadcrumbAllocationAccept: Accept allocation
|
||||
BreadcrumbAllocationAddUser: Add applicant
|
||||
BreadcrumbAllocationEditUser: Edit applicant
|
||||
BreadcrumbAllocationDelUser: Remove participant
|
||||
BreadcrumbMessageHide: Hide
|
||||
BreadcrumbFaq: FAQ
|
||||
BreadcrumbSheetPersonalisedFiles: Download personalised sheet files
|
||||
@ -113,7 +95,6 @@ BreadcrumbTermShow: Semesters
|
||||
BreadcrumbTermCreate: Create new semester
|
||||
BreadcrumbTermEdit: Edit semester
|
||||
BreadcrumbTermCurrent: Current semester
|
||||
BreadcrumbAllocationListTitle: Central allocations
|
||||
BreadcrumbParticipantsIntersect: Common course participants
|
||||
BreadcrumbCourseList: Courses
|
||||
BreadcrumbCourseNew: Create new course
|
||||
@ -133,7 +114,6 @@ BreadcrumbCourseEventNew: New course occurrence
|
||||
BreadcrumbCourseEventEdit: Edit course occurrence
|
||||
BreadcrumbExamList: Exams
|
||||
BreadcrumbExamNew: Create new exam
|
||||
BreadcrumbCourseApplications: Applications
|
||||
BreadcrumbExamEdit: Edit exam
|
||||
BreadcrumbExamUsers: Participants
|
||||
BreadcrumbExamGrades: Exam results
|
||||
|
||||
@ -9,11 +9,9 @@ MenuInfoLecturerCourses: Veranstaltungen
|
||||
MenuInfoLecturerExercises: Übungsbetrieb
|
||||
MenuInfoLecturerTutorials: Tutorien
|
||||
MenuInfoLecturerExams: Prüfungen
|
||||
MenuInfoLecturerAllocations: Zentralanmeldungen
|
||||
MenuCsvOptions: CSV-Optionen
|
||||
MenuCorrectorAssignTitle: Korrektor:in zuweisen
|
||||
MenuOpenCourses: Kurse mit offener Registrierung
|
||||
MenuOpenAllocations: Aktive Zentralanmeldungen
|
||||
MenuNews: Aktuell
|
||||
MenuInformation: Informationen
|
||||
MenuLegal: Rechtliche Informationen
|
||||
@ -29,15 +27,10 @@ MenuHelp: Hilfe
|
||||
MenuProfile: Anpassen
|
||||
MenuLogin !ident-ok: Login
|
||||
MenuLogout !ident-ok: Logout
|
||||
MenuAllocationList: Zentralanmeldungen
|
||||
MenuAllocationNew: Neue Zentralanmeldung anlegen
|
||||
MenuAllocationEdit: Zentralanmeldung bearbeiten
|
||||
MenuAllocationMatchings: Verteilungen
|
||||
MenuCourseList: Kurse
|
||||
MenuCourseMembers: Kursteilnehmer:innen
|
||||
MenuCourseAddMembers: Kursteilnehmer:innen hinzufügen
|
||||
MenuCourseCommunication: Kursmitteilung (E-Mail)
|
||||
MenuCourseApplications: Bewerbungen
|
||||
MenuCourseExamOffice: Prüfungsbeauftragte
|
||||
MenuTermShow: Semester
|
||||
MenuSubmissionDelete: Abgabe löschen
|
||||
@ -98,8 +91,6 @@ MenuExamOfficeExams: Prüfungen
|
||||
MenuExamOfficeFields: Fächer
|
||||
MenuExamOfficeUsers: Benutzer:innen
|
||||
MenuLecturerInvite: Funktionäre hinzufügen
|
||||
MenuAllocationInfo: Hinweise zum Ablauf einer Zentralanmeldung
|
||||
MenuCourseApplicationsFiles: Dateien aller Bewerbungen
|
||||
MenuSchoolList: Institute
|
||||
MenuSchoolNew: Neues Institut anlegen
|
||||
MenuExternalExamGrades: Prüfungsleistungen
|
||||
@ -110,12 +101,6 @@ MenuExternalExamList: Externe Prüfungen
|
||||
MenuExternalExamCorrect: Prüfungsleistungen eintragen
|
||||
MenuParticipantsList: Kursteilnehmerlisten
|
||||
MenuParticipantsIntersect: Überschneidung von Kursteilnehmer:innen
|
||||
MenuAllocationUsers: Bewerber:innen
|
||||
MenuAllocationPriorities: Zentrale Dringlichkeiten
|
||||
MenuAllocationCompute: Platzvergabe berechnen
|
||||
|
||||
MenuAllocationAddUser: Bewerber:in hinzufügen
|
||||
MenuAllocationDelUser: Bewerber:in entfernen
|
||||
MenuFaq !ident-ok: FAQ
|
||||
MenuSheetPersonalisedFiles: Personalisierte Dateien herunterladen
|
||||
MenuCourseSheetPersonalisedFiles: Vorlage für personalisierte Übungsblatt-Dateien herunterladen
|
||||
|
||||
@ -9,11 +9,9 @@ MenuInfoLecturerCourses: Courses
|
||||
MenuInfoLecturerExercises: Course Exercises
|
||||
MenuInfoLecturerTutorials: Tutorials
|
||||
MenuInfoLecturerExams: Exams
|
||||
MenuInfoLecturerAllocations: Central allocations
|
||||
MenuCsvOptions: CSV-options
|
||||
MenuCorrectorAssignTitle: Assign corrector
|
||||
MenuOpenCourses: Courses with open registration
|
||||
MenuOpenAllocations: Active central allocations
|
||||
MenuNews: News
|
||||
MenuInformation: Information
|
||||
MenuLegal: Legal
|
||||
@ -29,15 +27,10 @@ MenuHelp: Support
|
||||
MenuProfile: Settings
|
||||
MenuLogin: Login
|
||||
MenuLogout: Logout
|
||||
MenuAllocationList: Central allocations
|
||||
MenuAllocationNew: Create new allocation
|
||||
MenuAllocationEdit: Edit allocation
|
||||
MenuAllocationMatchings: Matchings
|
||||
MenuCourseList: Courses
|
||||
MenuCourseMembers: Participants
|
||||
MenuCourseAddMembers: Add participants
|
||||
MenuCourseCommunication: Course message (email)
|
||||
MenuCourseApplications: Applications
|
||||
MenuCourseExamOffice: Exam offices
|
||||
MenuTermShow: Semesters
|
||||
MenuSubmissionDelete: Delete submission
|
||||
@ -99,8 +92,6 @@ MenuExamOfficeExams: Exams
|
||||
MenuExamOfficeFields: Fields of study
|
||||
MenuExamOfficeUsers: Users
|
||||
MenuLecturerInvite: Add functionaries
|
||||
MenuAllocationInfo: Information regarding central allocations
|
||||
MenuCourseApplicationsFiles: Files of all applications
|
||||
MenuSchoolList: Departments
|
||||
MenuSchoolNew: Create new department
|
||||
MenuExternalExamGrades: Exam results
|
||||
@ -111,12 +102,6 @@ MenuExternalExamList: External exams
|
||||
MenuExternalExamCorrect: Enter exam results
|
||||
MenuParticipantsList: Lists of course participants
|
||||
MenuParticipantsIntersect: Common course participants
|
||||
MenuAllocationUsers: Applicants
|
||||
MenuAllocationPriorities: Central priorities
|
||||
MenuAllocationCompute: Compute allocation
|
||||
|
||||
MenuAllocationAddUser: Add applicant
|
||||
MenuAllocationDelUser: Remove participant
|
||||
MenuFaq: FAQ
|
||||
MenuSheetPersonalisedFiles: Download personalised sheet files
|
||||
MenuCourseSheetPersonalisedFiles: Download template for personalised sheet files
|
||||
|
||||
@ -1,70 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
Allocation -- attributes with prefix staff- affect lecturers only, but are invisble to students
|
||||
term TermId
|
||||
school SchoolId -- school that manages this central allocation, not necessarily school of courses
|
||||
shorthand AllocationShorthand -- practical shorthand
|
||||
name AllocationName
|
||||
legacyShorthands [AllocationShorthand] default='[]' -- just for association to previous allocations
|
||||
description StoredMarkup Maybe -- description for prospective students
|
||||
staffDescription StoredMarkup Maybe -- description seen by prospective lecturers only
|
||||
staffRegisterFrom UTCTime Maybe -- lectureres may register courses
|
||||
staffRegisterTo UTCTime Maybe -- course registration stops
|
||||
-- staffDeregisterUntil not needed: staff may make arbitrary changes until staffRegisterTo, always frozen afterwards
|
||||
staffAllocationFrom UTCTime Maybe -- lecturers may rate applicants from this day onwwards or prohibited
|
||||
staffAllocationTo UTCTime Maybe --
|
||||
-- Student register for this allocation
|
||||
-- canRegisterNow = maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo
|
||||
registerFrom UTCTime Maybe -- student applications allowed from a given day onwwards or prohibited
|
||||
registerTo UTCTime Maybe -- student applications may be prohibited from a given date onwards
|
||||
-- deregisterUntil not needed: students may withdraw applicants until registerTo, but never after. Also see overrideDeregister
|
||||
-- overrides
|
||||
registerByStaffFrom UTCTime Maybe -- lecturers may directly enrol/disenrol students after a given date or prohibited
|
||||
registerByStaffTo UTCTime Maybe
|
||||
registerByCourse UTCTime Maybe -- course registration dates are ignored until this day has passed or always prohibited
|
||||
overrideDeregister UTCTime Maybe -- deregister prohibited after this time or always allowed (defaulting to course settings)
|
||||
-- overrideVisible not needed, since courses are always visible
|
||||
matchingSeed ByteString default='\x'::bytea
|
||||
TermSchoolAllocationShort term school shorthand -- shorthand must be unique within school and semester
|
||||
TermSchoolAllocationName term school name -- name must be unique within school and semester
|
||||
deriving Show Eq Ord Generic
|
||||
|
||||
AllocationMatching
|
||||
allocation AllocationId
|
||||
fingerprint AllocationFingerprint
|
||||
time UTCTime
|
||||
log FileContentReference
|
||||
deriving Generic
|
||||
|
||||
AllocationCourse
|
||||
allocation AllocationId
|
||||
course CourseId
|
||||
minCapacity Int -- if the course would get assigned fewer than this many applicants, restart the assignment process without the course
|
||||
acceptSubstitutes UTCTime Maybe
|
||||
overrideSumCapacity Int Maybe -- mark course as outlier (ridiculously large capacity) and use this capacity instead for computing overall capacity of allocation
|
||||
UniqueAllocationCourse course
|
||||
deriving Generic
|
||||
|
||||
AllocationUser
|
||||
allocation AllocationId
|
||||
user UserId
|
||||
totalCourses Word64 -- number of total allocated courses for this user must be <= than this number
|
||||
priority AllocationPriority Maybe
|
||||
UniqueAllocationUser allocation user
|
||||
deriving Eq Ord Show Generic
|
||||
|
||||
AllocationDeregister -- self-inflicted user-deregistrations from an allocated course
|
||||
user UserId
|
||||
course CourseId Maybe OnDeleteSetNull OnUpdateCascade
|
||||
time UTCTime
|
||||
reason Text Maybe -- if this deregistration was done by proxy (e.g. the lecturer pressed the button)
|
||||
deriving Eq Ord Show Generic
|
||||
|
||||
AllocationNotificationSetting
|
||||
user UserId
|
||||
allocation AllocationId
|
||||
isOptOut Bool
|
||||
UniqueAllocationNotificationSetting user allocation
|
||||
deriving Generic
|
||||
@ -1,4 +1,4 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
@ -22,14 +22,8 @@ Course -- Information about a single course; contained info is always visible
|
||||
registerFrom UTCTime Maybe -- enrolement allowed from a given day onwwards or prohibited
|
||||
registerTo UTCTime Maybe -- enrolement may be prohibited from a given date onwards
|
||||
deregisterUntil UTCTime Maybe -- unenrolement may be prohibited from a given date onwards
|
||||
deregisterNoShow Bool default=false
|
||||
registerSecret Text Maybe -- enrolement maybe protected by a simple common passphrase
|
||||
materialFree Bool -- False: only enrolled users may see course materials not stored in this table
|
||||
applicationsRequired Bool default=false
|
||||
applicationsInstructions StoredMarkup Maybe
|
||||
applicationsText Bool default=false
|
||||
applicationsFiles UploadMode "default='{\"mode\": \"no-upload\"}'::jsonb"
|
||||
applicationsRatingsVisible Bool default=false
|
||||
TermSchoolCourseShort term school shorthand -- shorthand must be unique within school and semester
|
||||
TermSchoolCourseName term school name -- name must be unique within school and semester
|
||||
deriving Generic
|
||||
@ -67,7 +61,6 @@ CourseParticipant -- course enrolement
|
||||
user UserId
|
||||
registration UTCTime -- time of last enrolement for this course
|
||||
field StudyFeaturesId Maybe MigrationOnly
|
||||
allocated AllocationId Maybe -- participant was centrally allocated
|
||||
state CourseParticipantState
|
||||
UniqueParticipant user course
|
||||
deriving Eq Ord Show Generic
|
||||
|
||||
@ -1,25 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
CourseApplication
|
||||
course CourseId
|
||||
user UserId
|
||||
field StudyFeaturesId Maybe MigrationOnly
|
||||
text Text Maybe -- free text entered by user
|
||||
ratingVeto Bool default=false
|
||||
ratingPoints ExamGrade Maybe
|
||||
ratingComment Text Maybe
|
||||
allocation AllocationId Maybe
|
||||
allocationPriority Word64 Maybe
|
||||
time UTCTime default=now()
|
||||
ratingTime UTCTime Maybe
|
||||
deriving Generic
|
||||
|
||||
CourseApplicationFile
|
||||
application CourseApplicationId OnDeleteCascade OnUpdateCascade
|
||||
title FilePath
|
||||
content FileContentReference Maybe
|
||||
modified UTCTime
|
||||
UniqueCourseApplicationFile application title
|
||||
deriving Generic
|
||||
35
routes
35
routes
@ -81,7 +81,6 @@
|
||||
/info/lecturer InfoLecturerR GET !free
|
||||
/info/supervisor InfoSupervisorR GET !free
|
||||
/info/legal LegalR GET !free
|
||||
/info/allocation InfoAllocationR GET !free
|
||||
/info/glossary GlossaryR GET !free
|
||||
/info/faq FaqR GET !free
|
||||
/info/terms-of-use TermsOfUseR GET !free
|
||||
@ -138,24 +137,6 @@
|
||||
/ SchoolEditR GET POST
|
||||
|
||||
|
||||
/allocation/ AllocationListR GET !free
|
||||
!/allocation/new AllocationNewR GET POST !allocation-admin
|
||||
/allocation/#TermId/#SchoolId/#AllocationShorthand AllocationR:
|
||||
/ AShowR GET POST !free
|
||||
/edit AEditR GET POST !allocation-admin
|
||||
/register ARegisterR POST !time
|
||||
/course/#CryptoUUIDCourse/apply AApplyR POST !timeANDallocation-registered
|
||||
/users AUsersR GET POST !allocation-admin
|
||||
/users/#CryptoUUIDUser AEditUserR GET POST !allocation-admin
|
||||
/users/#CryptoUUIDUser/delete ADelUserR GET POST !allocation-admin
|
||||
!/users/add AAddUserR GET POST !allocation-admin
|
||||
/priorities APriosR GET POST !allocation-admin
|
||||
/compute AComputeR GET POST !allocation-admin
|
||||
/accept AAcceptR GET POST !allocation-admin
|
||||
/matchings AMatchingListR GET
|
||||
/matchings/#CryptoUUIDAllocationMatching AMatchingR:
|
||||
/log AMLogR GET
|
||||
|
||||
/participants ParticipantsListR GET !evaluation
|
||||
/participants/#TermId/#SchoolId ParticipantsR GET !evaluation
|
||||
/participants/intersect ParticipantsIntersectR GET POST !evaluation
|
||||
@ -165,16 +146,15 @@
|
||||
/course/ CourseListR GET !free
|
||||
!/course/new CourseNewR GET POST !lecturer
|
||||
/course/#TermId/#SchoolId/#CourseShorthand CourseR !lecturer:
|
||||
/ CShowR GET !tutor !corrector !exam-corrector !course-registered !course-time !evaluation !exam-office !allocation-admin
|
||||
/ CShowR GET !tutor !corrector !exam-corrector !course-registered !course-time !evaluation !exam-office
|
||||
/favourite CFavouriteR GET POST !free
|
||||
/register CRegisterR GET POST !timeANDcapacityANDallocation-timeAND¬course-registeredANDcourse-time !timeANDallocation-timeAND¬exam-resultANDcourse-registered !lecturerANDallocation-time
|
||||
/register-template CRegisterTemplateR GET !course-time
|
||||
/register CRegisterR GET POST !timeANDcapacityAND¬course-registeredANDcourse-time !timeAND¬exam-resultANDcourse-registered !lecturer
|
||||
/edit CEditR GET POST
|
||||
/lecturer-invite CLecInviteR GET POST
|
||||
/delete CDeleteR GET POST !lecturerANDemptyANDallocation-time
|
||||
/delete CDeleteR GET POST !lecturerANDempty
|
||||
/users CUsersR GET POST
|
||||
!/users/new CAddUserR GET POST !lecturerANDallocation-time
|
||||
/users/#CryptoUUIDUser CUserR GET POST !lecturerANDparticipant !lecturerANDapplicant
|
||||
!/users/new CAddUserR GET POST !lecturer
|
||||
/users/#CryptoUUIDUser CUserR GET POST !lecturerANDparticipant !lecturer
|
||||
/correctors CHiWisR GET
|
||||
/communication CCommR GET POST
|
||||
/notes CNotesR GET POST !corrector -- THIS route is used to check for overall course corrector access!
|
||||
@ -241,11 +221,6 @@
|
||||
/grades EGradesR GET POST !exam-office
|
||||
/assign-occurrences EAutoOccurrenceR POST
|
||||
/correct ECorrectR GET POST !exam-correctorANDtime
|
||||
/apps CApplicationsR GET POST
|
||||
!/apps/files CAppsFilesR GET
|
||||
/apps/#CryptoFileNameCourseApplication CourseApplicationR:
|
||||
/ CAEditR GET POST !timeANDself !lecturerANDstaff-time !selfANDread
|
||||
/files CAFilesR GET !self !lecturerANDstaff-time
|
||||
!/news/add CNewsNewR GET POST
|
||||
/news/#CryptoUUIDCourseNews CourseNewsR:
|
||||
/ CNShowR GET !timeANDparticipant
|
||||
|
||||
@ -145,7 +145,6 @@ import Handler.CryptoIDDispatch
|
||||
import Handler.SystemMessage
|
||||
import Handler.Health
|
||||
import Handler.Exam
|
||||
import Handler.Allocation
|
||||
import Handler.ExamOffice
|
||||
import Handler.Metrics
|
||||
import Handler.ExternalExam
|
||||
|
||||
@ -50,8 +50,6 @@ decCryptoIDs [ ''SubmissionId
|
||||
, ''ExamId
|
||||
, ''ExamOccurrenceId
|
||||
, ''ExamPartId
|
||||
, ''AllocationId
|
||||
, ''CourseApplicationId
|
||||
, ''CourseId
|
||||
, ''CourseNewsId
|
||||
, ''CourseEventId
|
||||
@ -59,7 +57,6 @@ decCryptoIDs [ ''SubmissionId
|
||||
, ''ExternalApiId
|
||||
, ''ExternalExamId
|
||||
, ''MaterialFileId
|
||||
, ''AllocationMatchingId
|
||||
, ''PrintJobId
|
||||
, ''QualificationId
|
||||
]
|
||||
|
||||
@ -510,7 +510,6 @@ tagAccessPredicate AuthAdmin = cacheAPSchoolFunction SchoolAdmin (Just $ Right d
|
||||
| maybe True (`Set.notMember` adminList) mAuthId' -> Right $ case route' of
|
||||
_ | is _Nothing mAuthId' -> return AuthenticationRequired
|
||||
CourseR{} -> unauthorizedI MsgUnauthorizedSchoolAdmin
|
||||
AllocationR{} -> unauthorizedI MsgUnauthorizedSchoolAdmin
|
||||
SchoolR _ _ -> unauthorizedI MsgUnauthorizedSchoolAdmin
|
||||
_other -> unauthorizedI MsgUnauthorizedSiteAdmin
|
||||
| otherwise -> Left $ APDB $ \_ _ mAuthId route _ -> case route of
|
||||
@ -526,18 +525,6 @@ tagAccessPredicate AuthAdmin = cacheAPSchoolFunction SchoolAdmin (Just $ Right d
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
guardMExceptT isAdmin $ unauthorizedI MsgUnauthorizedSchoolAdmin
|
||||
return Authorized
|
||||
-- Allocations: access only to school admins
|
||||
AllocationR tid ssh ash _ -> $cachedHereBinary (mAuthId, tid, ssh, ash) . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isAdmin <- lift . E.selectExists . E.from $ \(allocation `E.InnerJoin` userAdmin) -> do
|
||||
E.on $ allocation E.^. AllocationSchool E.==. userAdmin E.^. UserFunctionSchool
|
||||
E.where_ $ userAdmin E.^. UserFunctionUser E.==. E.val authId
|
||||
E.&&. userAdmin E.^. UserFunctionFunction E.==. E.val SchoolAdmin
|
||||
E.&&. allocation E.^. AllocationTerm E.==. E.val tid
|
||||
E.&&. allocation E.^. AllocationSchool E.==. E.val ssh
|
||||
E.&&. allocation E.^. AllocationShorthand E.==. E.val ash
|
||||
guardMExceptT isAdmin (unauthorizedI MsgUnauthorizedSchoolAdmin)
|
||||
return Authorized
|
||||
-- Schools: access only to school admins
|
||||
SchoolR ssh _ -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
@ -670,26 +657,6 @@ tagAccessPredicate AuthEvaluation = cacheAPSchoolFunction SchoolEvaluation (Just
|
||||
isEvaluation <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolEvaluation]
|
||||
guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedEvaluation
|
||||
return Authorized
|
||||
tagAccessPredicate AuthAllocationAdmin = cacheAPSchoolFunction SchoolAllocation (Just $ Right diffHour) $ \mAuthId' _ _ allocationList -> if
|
||||
| maybe True (`Set.notMember` allocationList) mAuthId' -> Right $ if
|
||||
| is _Nothing mAuthId' -> return AuthenticationRequired
|
||||
| otherwise -> unauthorizedI MsgUnauthorizedAllocationAdmin
|
||||
| otherwise -> Left $ APDB $ \_ _ mAuthId route _ -> case route of
|
||||
AllocationR _ ssh _ _ -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isEvaluation <- lift . existsBy $ UniqueUserFunction authId ssh SchoolAllocation
|
||||
guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedAllocationAdmin
|
||||
return Authorized
|
||||
CourseR _ ssh _ _ -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isEvaluation <- lift . existsBy $ UniqueUserFunction authId ssh SchoolAllocation
|
||||
guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedAllocationAdmin
|
||||
return Authorized
|
||||
_other -> $cachedHereBinary mAuthId . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isEvaluation <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolAllocation]
|
||||
guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedAllocationAdmin
|
||||
return Authorized
|
||||
tagAccessPredicate AuthToken = APDB $ \_ _ mAuthId route isWrite -> exceptT return return $
|
||||
lift . validateBearer mAuthId route isWrite =<< askBearerUnsafe
|
||||
tagAccessPredicate AuthNoEscalation = APDB $ \_ _ mAuthId route _ -> case route of
|
||||
@ -719,7 +686,6 @@ tagAccessPredicate AuthLecturer = cacheAPDB' (Just $ Right diffMinute) mkLecture
|
||||
, maybe True (`Set.notMember` lecturerList) mAuthId' -> Right $ case route' of
|
||||
_ | is _Nothing mAuthId' -> return AuthenticationRequired
|
||||
CourseR{} -> unauthorizedI MsgUnauthorizedLecturer
|
||||
AllocationR{} -> unauthorizedI MsgUnauthorizedAllocationLecturer
|
||||
EExamR{} -> unauthorizedI MsgUnauthorizedExternalExamLecturer
|
||||
_other -> unauthorizedI MsgUnauthorizedSchoolLecturer
|
||||
| otherwise -> Left $ APDB $ \_ _ mAuthId route _ -> case route of
|
||||
@ -733,18 +699,6 @@ tagAccessPredicate AuthLecturer = cacheAPDB' (Just $ Right diffMinute) mkLecture
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
guardMExceptT isLecturer (unauthorizedI MsgUnauthorizedLecturer)
|
||||
return Authorized
|
||||
AllocationR tid ssh ash _ -> $cachedHereBinary (mAuthId, tid, ssh, ash) . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isLecturer <- lift . E.selectExists . E.from $ \(allocation `E.InnerJoin` allocationCourse `E.InnerJoin` course `E.InnerJoin` lecturer) -> do
|
||||
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
|
||||
E.on $ course E.^. CourseId E.==. allocationCourse E.^. AllocationCourseCourse
|
||||
E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
|
||||
E.where_ $ lecturer E.^. LecturerUser E.==. E.val authId
|
||||
E.&&. allocation E.^. AllocationTerm E.==. E.val tid
|
||||
E.&&. allocation E.^. AllocationSchool E.==. E.val ssh
|
||||
E.&&. allocation E.^. AllocationShorthand E.==. E.val ash
|
||||
guardMExceptT isLecturer $ unauthorizedI MsgUnauthorizedAllocationLecturer
|
||||
return Authorized
|
||||
EExamR tid ssh coursen examn _ -> $cachedHereBinary (mAuthId, tid, ssh, coursen, examn) . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isLecturer <- lift . E.selectExists . E.from $ \(eexam `E.InnerJoin` staff) -> do
|
||||
@ -764,7 +718,6 @@ tagAccessPredicate AuthLecturer = cacheAPDB' (Just $ Right diffMinute) mkLecture
|
||||
where
|
||||
mkLecturerList _ route _ = case route of
|
||||
CourseR{} -> cacheLecturerList
|
||||
AllocationR{} -> cacheLecturerList
|
||||
EExamR{} -> Just
|
||||
( AuthCacheExternalExamStaffList
|
||||
, fmap (setOf $ folded . _Value) . E.select . E.from $ return . (E.^. ExternalExamStaffUser)
|
||||
@ -1058,31 +1011,6 @@ tagAccessPredicate AuthTime = APDB $ \_ (runTACont -> cont) mAuthId route isWrit
|
||||
guard $ NTop (Just now) <= NTop deregUntil
|
||||
return Authorized
|
||||
_other -> unauthorizedI MsgUnauthorizedCourseRegistrationTime
|
||||
|
||||
CApplicationR tid ssh csh _ _ -> maybeT (unauthorizedI MsgUnauthorizedApplicationTime) $ do
|
||||
Entity course Course{..} <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
|
||||
allocationCourse <- $cachedHereBinary course . lift . getBy $ UniqueAllocationCourse course
|
||||
allocation <- for allocationCourse $ \(Entity _ AllocationCourse{..}) -> $cachedHereBinary allocationCourseAllocation . MaybeT $ get allocationCourseAllocation
|
||||
|
||||
case allocation of
|
||||
Nothing -> do
|
||||
cTime <- liftIO getCurrentTime
|
||||
guard $ maybe False (cTime >=) courseRegisterFrom
|
||||
guard $ maybe True (cTime <=) courseRegisterTo
|
||||
Just Allocation{..} -> do
|
||||
cTime <- liftIO getCurrentTime
|
||||
guard $ NTop allocationRegisterFrom <= NTop (Just cTime)
|
||||
guard $ NTop (Just cTime) <= NTop allocationRegisterTo
|
||||
|
||||
return Authorized
|
||||
|
||||
AllocationR tid ssh ash _ -> maybeT (unauthorizedI MsgUnauthorizedAllocationRegisterTime) $ do
|
||||
-- Checks `registerFrom` and `registerTo`, override as further routes become available
|
||||
now <- liftIO getCurrentTime
|
||||
Entity _ Allocation{..} <- MaybeT . $cachedHereBinary (tid, ssh, ash) . getBy $ TermSchoolAllocationShort tid ssh ash
|
||||
guard $ NTop allocationRegisterFrom <= NTop (Just now)
|
||||
guard $ NTop (Just now) <= NTop allocationRegisterTo
|
||||
return Authorized
|
||||
|
||||
MessageR cID -> maybeT (unauthorizedI MsgUnauthorizedSystemMessageTime) $ do
|
||||
smId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
|
||||
@ -1120,75 +1048,6 @@ tagAccessPredicate AuthTime = APDB $ \_ (runTACont -> cont) mAuthId route isWrit
|
||||
return Authorized
|
||||
|
||||
r -> $unsupportedAuthPredicate AuthTime r
|
||||
tagAccessPredicate AuthStaffTime = APDB $ \_ _ _ route isWrite -> case route of
|
||||
CApplicationR tid ssh csh _ _ -> maybeT (unauthorizedI MsgUnauthorizedApplicationTime) $ do
|
||||
course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
|
||||
allocationCourse <- $cachedHereBinary course . lift . getBy $ UniqueAllocationCourse course
|
||||
allocation <- for allocationCourse $ \(Entity _ AllocationCourse{..}) -> $cachedHereBinary allocationCourseAllocation . MaybeT $ get allocationCourseAllocation
|
||||
|
||||
case allocation of
|
||||
Nothing -> return ()
|
||||
Just Allocation{..} -> do
|
||||
cTime <- liftIO getCurrentTime
|
||||
guard $ NTop allocationStaffAllocationFrom <= NTop (Just cTime)
|
||||
when isWrite $
|
||||
guard $ NTop (Just cTime) <= NTop allocationStaffAllocationTo
|
||||
|
||||
return Authorized
|
||||
|
||||
AllocationR tid ssh ash _ -> maybeT (unauthorizedI MsgUnauthorizedAllocationRegisterTime) $ do
|
||||
-- Checks `registerFrom` and `registerTo`, override as further routes become available
|
||||
now <- liftIO getCurrentTime
|
||||
Entity _ Allocation{..} <- MaybeT . $cachedHereBinary (tid, ssh, ash) . getBy $ TermSchoolAllocationShort tid ssh ash
|
||||
guard $ NTop allocationStaffAllocationFrom <= NTop (Just now)
|
||||
guard $ NTop (Just now) <= NTop allocationStaffAllocationTo
|
||||
return Authorized
|
||||
|
||||
r -> $unsupportedAuthPredicate AuthStaffTime r
|
||||
tagAccessPredicate AuthAllocationTime = APDB $ \_ (runTACont -> cont) mAuthId route isWrite -> case route of
|
||||
CourseR tid ssh csh CRegisterR -> do
|
||||
now <- liftIO getCurrentTime
|
||||
mba <- mbAllocation tid ssh csh
|
||||
case mba of
|
||||
Nothing -> return Authorized
|
||||
Just (_, Allocation{..}) -> do
|
||||
registered <- cont (predDNFSingleton $ PLVariable AuthCourseRegistered) mAuthId route isWrite
|
||||
if
|
||||
| not registered
|
||||
, NTop allocationRegisterByCourse >= NTop (Just now)
|
||||
-> unauthorizedI MsgUnauthorizedAllocatedCourseRegister
|
||||
| registered
|
||||
, NTop (Just now) >= NTop allocationOverrideDeregister
|
||||
-> unauthorizedI MsgUnauthorizedAllocatedCourseDeregister
|
||||
| otherwise
|
||||
-> return Authorized
|
||||
|
||||
CourseR tid ssh csh CAddUserR -> do
|
||||
now <- liftIO getCurrentTime
|
||||
mba <- mbAllocation tid ssh csh
|
||||
case mba of
|
||||
Just (_, Allocation{..})
|
||||
| NTop allocationRegisterByStaffTo <= NTop (Just now)
|
||||
|| NTop allocationRegisterByStaffFrom >= NTop (Just now)
|
||||
-> unauthorizedI MsgUnauthorizedAllocatedCourseRegister
|
||||
_other -> return Authorized
|
||||
|
||||
CourseR tid ssh csh CDeleteR -> do
|
||||
now <- liftIO getCurrentTime
|
||||
mba <- mbAllocation tid ssh csh
|
||||
case mba of
|
||||
Just (_, Allocation{..})
|
||||
| NTop allocationRegisterByStaffTo <= NTop (Just now)
|
||||
|| NTop allocationRegisterByStaffFrom >= NTop (Just now)
|
||||
-> unauthorizedI MsgUnauthorizedAllocatedCourseDelete
|
||||
_other -> return Authorized
|
||||
|
||||
r -> $unsupportedAuthPredicate AuthAllocationTime r
|
||||
where
|
||||
mbAllocation tid ssh csh = $cachedHereBinary (tid, ssh, csh) . runMaybeT $ do
|
||||
cid <- MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
|
||||
Entity _ AllocationCourse{..} <- MaybeT . getBy $ UniqueAllocationCourse cid
|
||||
(cid,) <$> MaybeT (get allocationCourseAllocation)
|
||||
tagAccessPredicate AuthCourseTime = APDB $ \_ _ _mAuthId route _ -> case route of
|
||||
CourseR tid ssh csh _ -> exceptT return return $ do
|
||||
now <- liftIO getCurrentTime
|
||||
@ -1196,7 +1055,7 @@ tagAccessPredicate AuthCourseTime = APDB $ \_ _ _mAuthId route _ -> case route o
|
||||
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.&&. courseIsVisible now course E.nothing
|
||||
E.&&. courseIsVisible now course
|
||||
guardMExceptT courseVisible (unauthorizedI MsgUnauthorizedCourseTime)
|
||||
return Authorized
|
||||
r -> $unsupportedAuthPredicate AuthCourseTime r
|
||||
@ -1415,13 +1274,6 @@ tagAccessPredicate AuthExamResult = APDB $ \_ _ mAuthId route _ -> case route of
|
||||
guardMExceptT (hasResult || hasPartResult) (unauthorizedI MsgUnauthorizedExamResult)
|
||||
return Authorized
|
||||
r -> $unsupportedAuthPredicate AuthExamRegistered r
|
||||
tagAccessPredicate AuthAllocationRegistered = APDB $ \_ _ mAuthId route _ -> case route of
|
||||
AllocationR tid ssh ash _ -> maybeT (unauthorizedI MsgUnauthorizedAllocationRegistered) $ do
|
||||
uid <- hoistMaybe mAuthId
|
||||
aId <- MaybeT . $cachedHereBinary (tid, ssh, ash) . getKeyBy $ TermSchoolAllocationShort tid ssh ash
|
||||
void . MaybeT . $cachedHereBinary (uid, aId) . getKeyBy $ UniqueAllocationUser aId uid
|
||||
return Authorized
|
||||
r -> $unsupportedAuthPredicate AuthAllocationRegistered r
|
||||
tagAccessPredicate AuthParticipant = APDB $ \_ _ mAuthId route _ -> case route of
|
||||
CNewsR tid ssh csh cID _ -> maybeT (unauthorizedI MsgUnauthorizedParticipantSelf) $ do
|
||||
nId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
|
||||
@ -1530,27 +1382,6 @@ tagAccessPredicate AuthParticipant = APDB $ \_ _ mAuthId route _ -> case route o
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
tagAccessPredicate AuthApplicant = APDB $ \_ _ mAuthId route _ -> case route of
|
||||
CourseR tid ssh csh (CUserR cID) -> maybeT (unauthorizedI MsgUnauthorizedApplicant) $ do
|
||||
uid <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
|
||||
isApplicant <- isCourseApplicant tid ssh csh uid
|
||||
guard isApplicant
|
||||
return Authorized
|
||||
|
||||
CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgUnauthorizedApplicantSelf) $ do
|
||||
uid <- hoistMaybe mAuthId
|
||||
isApplicant <- isCourseApplicant tid ssh csh uid
|
||||
guard isApplicant
|
||||
return Authorized
|
||||
|
||||
r -> $unsupportedAuthPredicate AuthApplicant r
|
||||
where
|
||||
isCourseApplicant tid ssh csh uid = lift . $cachedHereBinary (uid, tid, ssh, csh) . E.selectExists . E.from $ \(course `E.InnerJoin` courseApplication) -> do
|
||||
E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
|
||||
E.where_ $ courseApplication E.^. CourseApplicationUser E.==. E.val uid
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
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
|
||||
@ -1674,10 +1505,6 @@ tagAccessPredicate AuthSelf = APDB $ \_ _ mAuthId route _ -> exceptT return retu
|
||||
UserNotificationR cID -> return $ Left cID
|
||||
UserPasswordR cID -> return $ Left cID
|
||||
CourseR _ _ _ (CUserR cID) -> return $ Left cID
|
||||
CApplicationR _ _ _ cID _ -> do
|
||||
appId <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedSelf) (const True :: CryptoIDError -> Bool) $ decrypt cID
|
||||
CourseApplication{..} <- maybeMExceptT (unauthorizedI MsgUnauthorizedSelf) . $cachedHereBinary appId $ get appId
|
||||
return $ Right courseApplicationUser
|
||||
_other -> throwError =<< $unsupportedAuthPredicate AuthSelf route
|
||||
referencedUser <- case referencedUser' of
|
||||
Right uid -> return uid
|
||||
@ -1769,7 +1596,6 @@ routeAuthTags = fmap predDNFEntail . ofoldM parse defaultAuthDNF . routeAttrs
|
||||
broadenRoute :: AuthTag -> Route UniWorX -> Route UniWorX
|
||||
broadenRoute aTag route = case (aTag, route) of
|
||||
(AuthAdmin, CourseR tid ssh csh _) -> CourseR tid ssh csh CShowR
|
||||
(AuthAdmin, AllocationR tid ssh ash _) -> AllocationR tid ssh ash AShowR
|
||||
(AuthAdmin, SchoolR ssh _) -> SchoolR ssh SchoolEditR
|
||||
(AuthAdmin, _) -> NewsR
|
||||
|
||||
@ -1782,7 +1608,6 @@ broadenRoute aTag route = case (aTag, route) of
|
||||
(AuthExamOffice, _) -> NewsR
|
||||
|
||||
(AuthLecturer, CourseR tid ssh csh _) -> CourseR tid ssh csh CShowR
|
||||
(AuthLecturer, AllocationR tid ssh ash _) -> AllocationR tid ssh ash AShowR
|
||||
(AuthLecturer, EExamR tid ssh coursen examn _) -> EExamR tid ssh coursen examn EEShowR
|
||||
(AuthLecturer, _) -> NewsR
|
||||
|
||||
@ -1927,7 +1752,4 @@ authoritiveApproot = \case
|
||||
CourseR _ _ _ (SheetR _ (SubmissionR _ (SubArchiveR _))) -> ApprootUserGenerated
|
||||
CourseR _ _ _ (CourseNewsR _ (CNFileR _)) -> ApprootUserGenerated
|
||||
CourseR _ _ _ (CourseNewsR _ CNArchiveR) -> ApprootUserGenerated
|
||||
CourseR _ _ _ CRegisterTemplateR -> ApprootUserGenerated
|
||||
CourseR _ _ _ CAppsFilesR -> ApprootUserGenerated
|
||||
CourseR _ _ _ (CourseApplicationR _ CAFilesR) -> ApprootUserGenerated
|
||||
_other -> ApprootDefault
|
||||
|
||||
@ -9,7 +9,7 @@ module Foundation.I18n
|
||||
( appLanguages, appLanguagesOpts
|
||||
, UniWorXMessage(..), UniWorXTestMessage(..), UniWorXSettingsMessage(..)
|
||||
, UniWorXHelpMessage(..), UniWorXNavigationMessage(..)
|
||||
, UniWorXCourseMessage(..), UniWorXAllocationMessage(..), UniWorXExamMessage(..)
|
||||
, UniWorXCourseMessage(..), UniWorXExamMessage(..)
|
||||
, UniWorXSheetMessage(..), UniWorXAdminMessage(..), UniWorXSubmissionMessage(..)
|
||||
, UniWorXTutorialMessage(..), UniWorXUserMessage(..), UniWorXButtonMessage(..)
|
||||
, UniWorXFormMessage(..), UniWorXRatingMessage(..), UniWorXTableColumnMessage(..)
|
||||
@ -135,10 +135,10 @@ noneOneMoreEN num noneText singularForm pluralForm
|
||||
-- | num == 0 = noneText
|
||||
-- | otherwise = someText
|
||||
|
||||
ordinalEN :: ToMessage a
|
||||
_ordinalEN :: ToMessage a
|
||||
=> a
|
||||
-> Text
|
||||
ordinalEN (toMessage -> numStr) = case lastChar of
|
||||
_ordinalEN (toMessage -> numStr) = case lastChar of
|
||||
Just '1' -> [st|#{numStr}st|]
|
||||
Just '2' -> [st|#{numStr}nd|]
|
||||
Just '3' -> [st|#{numStr}rd|]
|
||||
@ -189,7 +189,6 @@ mkMessageAddition ''UniWorX "Settings" "messages/uniworx/categories/settings" "d
|
||||
mkMessageAddition ''UniWorX "Help" "messages/uniworx/categories/help" "de-de-formal"
|
||||
mkMessageAddition ''UniWorX "Navigation" "messages/uniworx/utils/navigation" "de-de-formal"
|
||||
mkMessageAddition ''UniWorX "Course" "messages/uniworx/categories/courses/courses" "de-de-formal"
|
||||
mkMessageAddition ''UniWorX "Allocation" "messages/uniworx/categories/courses/allocation" "de-de-formal"
|
||||
mkMessageAddition ''UniWorX "Exam" "messages/uniworx/categories/courses/exam" "de-de-formal"
|
||||
mkMessageAddition ''UniWorX "Sheet" "messages/uniworx/categories/courses/sheet" "de-de-formal"
|
||||
mkMessageAddition ''UniWorX "Admin" "messages/uniworx/categories/admin" "de-de-formal"
|
||||
|
||||
@ -143,7 +143,6 @@ breadcrumb DataProtectionR = i18nCrumb MsgMenuDataProt $ Just Legal
|
||||
breadcrumb TermsOfUseR = i18nCrumb MsgMenuTermsUse $ Just LegalR
|
||||
breadcrumb PaymentsR = i18nCrumb MsgMenuPayments $ Just LegalR
|
||||
|
||||
breadcrumb InfoAllocationR = i18nCrumb MsgBreadcrumbAllocationInfo $ Just InfoR
|
||||
breadcrumb VersionR = i18nCrumb MsgMenuVersion $ Just InfoR
|
||||
breadcrumb FaqR = i18nCrumb MsgBreadcrumbFaq $ Just InfoR
|
||||
|
||||
@ -207,36 +206,6 @@ breadcrumb (TermSchoolCourseListR tid ssh) = useRunDB . maybeT (i18nCrumb MsgBre
|
||||
<*> fmap isJust (get tid)
|
||||
return (CI.original $ unSchoolKey ssh, Just $ TermCourseListR tid)
|
||||
|
||||
breadcrumb AllocationListR = i18nCrumb MsgAllocationListTitle $ Just NewsR
|
||||
breadcrumb AllocationNewR = i18nCrumb MsgBreadcrumbAllocationNew $ Just AllocationListR
|
||||
breadcrumb (AllocationR tid ssh ash sRoute) = case sRoute of
|
||||
AShowR -> useRunDB . maybeT (i18nCrumb MsgBreadcrumbAllocation $ Just AllocationListR) $ do
|
||||
mr <- getMessageRender
|
||||
Entity _ Allocation{allocationName} <- MaybeT . getBy $ TermSchoolAllocationShort tid ssh ash
|
||||
return ([st|#{allocationName} (#{mr (ShortTermIdentifier (unTermKey tid))}, #{CI.original (unSchoolKey ssh)})|], Just AllocationListR)
|
||||
AEditR -> i18nCrumb MsgBreadcrumbAllocationEdit . Just $ AllocationR tid ssh ash AShowR
|
||||
AMatchingListR -> i18nCrumb MsgBreadcrumbAllocationMatchings . Just $ AllocationR tid ssh ash AShowR
|
||||
AMatchingR _ AMLogR -> i18nCrumb MsgBreadcrumbAllocationMatchingLog . Just $ AllocationR tid ssh ash AMatchingListR
|
||||
ARegisterR -> i18nCrumb MsgBreadcrumbAllocationRegister . Just $ AllocationR tid ssh ash AShowR
|
||||
AApplyR cID -> useRunDB . maybeT (i18nCrumb MsgBreadcrumbCourse . Just $ AllocationR tid ssh ash AShowR) $ do
|
||||
cid <- decrypt cID
|
||||
Course{..} <- do
|
||||
aid <- MaybeT . getKeyBy $ TermSchoolAllocationShort tid ssh ash
|
||||
guardM . lift $ exists [ AllocationCourseAllocation ==. aid, AllocationCourseCourse ==. cid ]
|
||||
MaybeT $ get cid
|
||||
return (CI.original courseName, Just $ AllocationR tid ssh ash AShowR)
|
||||
AUsersR -> i18nCrumb MsgBreadcrumbAllocationUsers . Just $ AllocationR tid ssh ash AShowR
|
||||
APriosR -> i18nCrumb MsgBreadcrumbAllocationPriorities . Just $ AllocationR tid ssh ash AUsersR
|
||||
AComputeR -> i18nCrumb MsgBreadcrumbAllocationCompute . Just $ AllocationR tid ssh ash AUsersR
|
||||
AAcceptR -> i18nCrumb MsgBreadcrumbAllocationAccept . Just $ AllocationR tid ssh ash AUsersR
|
||||
AAddUserR -> i18nCrumb MsgBreadcrumbAllocationAddUser . Just $ AllocationR tid ssh ash AUsersR
|
||||
AEditUserR cID -> useRunDB . maybeT (i18nCrumb MsgBreadcrumbAllocationEditUser . Just $ AllocationR tid ssh ash AUsersR) $ do
|
||||
guardM . lift . hasReadAccessTo . AllocationR tid ssh ash $ AEditUserR cID
|
||||
uid <- decrypt cID
|
||||
User{..} <- MaybeT $ get uid
|
||||
return (userDisplayName, Just $ AllocationR tid ssh ash AUsersR)
|
||||
ADelUserR cID -> i18nCrumb MsgBreadcrumbAllocationDelUser . Just $ AllocationR tid ssh ash (AEditUserR cID)
|
||||
|
||||
breadcrumb ParticipantsListR = i18nCrumb MsgBreadcrumbParticipantsList $ Just CourseListR
|
||||
breadcrumb (ParticipantsR _ _) = i18nCrumb MsgBreadcrumbParticipants $ Just ParticipantsListR
|
||||
breadcrumb ParticipantsIntersectR = i18nCrumb MsgMenuParticipantsIntersect $ Just ParticipantsListR
|
||||
@ -266,7 +235,6 @@ breadcrumb (CourseR tid ssh csh CTutorialListR) = i18nCrumb MsgMenuTutorialList
|
||||
breadcrumb (CourseR tid ssh csh CTutorialNewR) = i18nCrumb MsgMenuTutorialNew . Just $ CourseR tid ssh csh CTutorialListR
|
||||
breadcrumb (CourseR tid ssh csh CFavouriteR) = i18nCrumb MsgBreadcrumbCourseFavourite . Just $ CourseR tid ssh csh CShowR
|
||||
breadcrumb (CourseR tid ssh csh CRegisterR) = i18nCrumb MsgBreadcrumbCourseRegister . Just $ CourseR tid ssh csh CShowR
|
||||
breadcrumb (CourseR tid ssh csh CRegisterTemplateR) = i18nCrumb MsgBreadcrumbCourseRegisterTemplate . Just $ CourseR tid ssh csh CShowR
|
||||
breadcrumb (CourseR tid ssh csh CLecInviteR) = i18nCrumb MsgBreadcrumbLecturerInvite . Just $ CourseR tid ssh csh CShowR
|
||||
breadcrumb (CourseR tid ssh csh CDeleteR) = i18nCrumb MsgMenuCourseDelete . Just $ CourseR tid ssh csh CShowR
|
||||
breadcrumb (CourseR tid ssh csh CHiWisR) = i18nCrumb MsgBreadcrumbHiWis . Just $ CourseR tid ssh csh CShowR
|
||||
@ -288,17 +256,6 @@ breadcrumb (CourseR tid ssh csh (CourseEventR _cID sRoute)) = case sRoute of
|
||||
breadcrumb (CourseR tid ssh csh CExamListR) = i18nCrumb MsgMenuExamList . Just $ CourseR tid ssh csh CShowR
|
||||
breadcrumb (CourseR tid ssh csh CExamNewR) = i18nCrumb MsgMenuExamNew . Just $ CourseR tid ssh csh CExamListR
|
||||
|
||||
breadcrumb (CourseR tid ssh csh CApplicationsR) = i18nCrumb MsgMenuCourseApplications . Just $ CourseR tid ssh csh CShowR
|
||||
breadcrumb (CourseR tid ssh csh CAppsFilesR) = i18nCrumb MsgBreadcrumbCourseAppsFiles . Just $ CourseR tid ssh csh CApplicationsR
|
||||
|
||||
breadcrumb (CourseR tid ssh csh (CourseApplicationR cID sRoute)) = case sRoute of
|
||||
CAEditR -> useRunDB . maybeT (i18nCrumb MsgBreadcrumbApplicant . Just $ CourseR tid ssh csh CApplicationsR) $ do
|
||||
guardM . lift . hasReadAccessTo $ CApplicationR tid ssh csh cID CAEditR
|
||||
appId <- decrypt cID
|
||||
User{..} <- MaybeT (get appId) >>= MaybeT . get . courseApplicationUser
|
||||
return (userDisplayName, Just $ CourseR tid ssh csh CApplicationsR)
|
||||
CAFilesR -> i18nCrumb MsgBreadcrumbApplicationFiles . Just $ CApplicationR tid ssh csh cID CAEditR
|
||||
|
||||
breadcrumb (CourseR tid ssh csh (ExamR examn sRoute)) = case sRoute of
|
||||
EShowR -> useRunDB . maybeT (i18nCrumb MsgBreadcrumbExam . Just $ CourseR tid ssh csh CExamListR) $ do
|
||||
guardM . lift . hasReadAccessTo $ CExamR tid ssh csh examn EShowR
|
||||
@ -877,14 +834,6 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the
|
||||
, navQuick' = mempty
|
||||
, navForceActive = False
|
||||
}
|
||||
, NavLink
|
||||
{ navLabel = MsgMenuAllocationList
|
||||
, navRoute = AllocationListR
|
||||
, navAccess' = NavAccessTrue
|
||||
, navType = NavTypeLink { navModal = False }
|
||||
, navQuick' = mempty
|
||||
, navForceActive = False
|
||||
}
|
||||
, NavLink
|
||||
{ navLabel = MsgMenuInfoLecturerTitle
|
||||
, navRoute = InfoLecturerR
|
||||
@ -917,17 +866,6 @@ pageActions NewsR = return
|
||||
}
|
||||
, navChildren = []
|
||||
}
|
||||
, NavPageActionPrimary
|
||||
{ navLink = NavLink
|
||||
{ navLabel = MsgMenuOpenAllocations
|
||||
, navRoute = (AllocationListR, [("allocations-active", toPathPiece True)])
|
||||
, navAccess' = NavAccessTrue
|
||||
, navType = NavTypeLink { navModal = False }
|
||||
, navQuick' = mempty
|
||||
, navForceActive = False
|
||||
}
|
||||
, navChildren = []
|
||||
}
|
||||
]
|
||||
pageActions (CourseR tid ssh csh CShowR) = do
|
||||
materialListSecondary <- pageQuickActions NavQuickViewPageActionSecondary $ CourseR tid ssh csh MaterialListR
|
||||
@ -1354,7 +1292,6 @@ pageActions HelpR = return
|
||||
, ("exercises", MsgMenuInfoLecturerExercises)
|
||||
, ("tutorials", MsgMenuInfoLecturerTutorials)
|
||||
, ("exams", MsgMenuInfoLecturerExams)
|
||||
, ("allocations", MsgMenuInfoLecturerAllocations)
|
||||
] :: [(Text, UniWorXNavigationMessage)]
|
||||
return NavLink
|
||||
{ navLabel
|
||||
@ -1451,121 +1388,6 @@ pageActions TermShowR = do
|
||||
, navChildren = participantsSecondary
|
||||
}
|
||||
]
|
||||
pageActions AllocationListR = return
|
||||
[ NavPageActionPrimary
|
||||
{ navLink = NavLink
|
||||
{ navLabel = MsgMenuAllocationNew
|
||||
, navRoute = AllocationNewR
|
||||
, navAccess' = NavAccessTrue
|
||||
, navType = NavTypeLink { navModal = False }
|
||||
, navQuick' = mempty
|
||||
, navForceActive = False
|
||||
}
|
||||
, navChildren = []
|
||||
}
|
||||
]
|
||||
pageActions (AllocationR tid ssh ash AShowR) = return
|
||||
[ NavPageActionPrimary
|
||||
{ navLink = NavLink
|
||||
{ navLabel = MsgMenuAllocationInfo
|
||||
, navRoute = InfoAllocationR
|
||||
, navAccess' = NavAccessTrue
|
||||
, navType = NavTypeLink { navModal = True }
|
||||
, navQuick' = mempty
|
||||
, navForceActive = False
|
||||
}
|
||||
, navChildren = []
|
||||
}
|
||||
, NavPageActionPrimary
|
||||
{ navLink = NavLink
|
||||
{ navLabel = MsgMenuAllocationUsers
|
||||
, navRoute = AllocationR tid ssh ash AUsersR
|
||||
, navAccess' = NavAccessTrue
|
||||
, navType = NavTypeLink { navModal = False }
|
||||
, navQuick' = mempty
|
||||
, navForceActive = False
|
||||
}
|
||||
, navChildren = []
|
||||
}
|
||||
, NavPageActionPrimary
|
||||
{ navLink = NavLink
|
||||
{ navLabel = MsgMenuAllocationCompute
|
||||
, navRoute = AllocationR tid ssh ash AComputeR
|
||||
, navAccess' = NavAccessTrue
|
||||
, navType = NavTypeLink { navModal = False }
|
||||
, navQuick' = mempty
|
||||
, navForceActive = False
|
||||
}
|
||||
, navChildren = []
|
||||
}
|
||||
, NavPageActionSecondary
|
||||
{ navLink = NavLink
|
||||
{ navLabel = MsgMenuAllocationEdit
|
||||
, navRoute = AllocationR tid ssh ash AEditR
|
||||
, navAccess' = NavAccessTrue
|
||||
, navType = NavTypeLink { navModal = False }
|
||||
, navQuick' = mempty
|
||||
, navForceActive = False
|
||||
}
|
||||
}
|
||||
, NavPageActionSecondary
|
||||
{ navLink = NavLink
|
||||
{ navLabel = MsgMenuAllocationMatchings
|
||||
, navRoute = AllocationR tid ssh ash AMatchingListR
|
||||
, navAccess' = NavAccessTrue
|
||||
, navType = NavTypeLink { navModal = True }
|
||||
, navQuick' = mempty
|
||||
, navForceActive = False
|
||||
}
|
||||
}
|
||||
]
|
||||
pageActions (AllocationR tid ssh ash AUsersR) = return
|
||||
[ NavPageActionPrimary
|
||||
{ navLink = NavLink
|
||||
{ navLabel = MsgMenuAllocationPriorities
|
||||
, navRoute = AllocationR tid ssh ash APriosR
|
||||
, navAccess' = NavAccessTrue
|
||||
, navType = NavTypeLink { navModal = False }
|
||||
, navQuick' = mempty
|
||||
, navForceActive = False
|
||||
}
|
||||
, navChildren = []
|
||||
}
|
||||
, NavPageActionPrimary
|
||||
{ navLink = NavLink
|
||||
{ navLabel = MsgMenuAllocationCompute
|
||||
, navRoute = AllocationR tid ssh ash AComputeR
|
||||
, navAccess' = NavAccessTrue
|
||||
, navType = NavTypeLink { navModal = False }
|
||||
, navQuick' = mempty
|
||||
, navForceActive = False
|
||||
}
|
||||
, navChildren = []
|
||||
}
|
||||
, NavPageActionPrimary
|
||||
{ navLink = NavLink
|
||||
{ navLabel = MsgMenuAllocationAddUser
|
||||
, navRoute = AllocationR tid ssh ash AAddUserR
|
||||
, navAccess' = NavAccessTrue
|
||||
, navType = NavTypeLink { navModal = False }
|
||||
, navQuick' = mempty
|
||||
, navForceActive = False
|
||||
}
|
||||
, navChildren = []
|
||||
}
|
||||
]
|
||||
pageActions (AllocationR tid ssh ash (AEditUserR cID)) = return
|
||||
[ NavPageActionSecondary
|
||||
{ navLink = NavLink
|
||||
{ navLabel = MsgMenuAllocationDelUser
|
||||
, navRoute = AllocationR tid ssh ash $ ADelUserR cID
|
||||
, navAccess' = NavAccessTrue
|
||||
, navType = NavTypeLink { navModal = True }
|
||||
, navQuick' = mempty
|
||||
, navForceActive = False
|
||||
}
|
||||
}
|
||||
]
|
||||
pageActions CourseListR = do
|
||||
participantsSecondary <- pageQuickActions NavQuickViewPageActionSecondary ParticipantsListR
|
||||
return
|
||||
@ -1580,17 +1402,6 @@ pageActions CourseListR = do
|
||||
}
|
||||
, navChildren = []
|
||||
}
|
||||
, NavPageActionPrimary
|
||||
{ navLink = NavLink
|
||||
{ navLabel = MsgMenuAllocationList
|
||||
, navRoute = AllocationListR
|
||||
, navAccess' = NavAccessTrue
|
||||
, navType = NavTypeLink { navModal = False }
|
||||
, navQuick' = mempty
|
||||
, navForceActive = False
|
||||
}
|
||||
, navChildren = []
|
||||
}
|
||||
, NavPageActionPrimary
|
||||
{ navLink = NavLink
|
||||
{ navLabel = MsgMenuParticipantsList
|
||||
@ -1726,31 +1537,6 @@ pageActions (CourseR tid ssh csh CUsersR) = return
|
||||
}
|
||||
, navChildren = []
|
||||
}
|
||||
, NavPageActionPrimary
|
||||
{ navLink = NavLink
|
||||
{ navLabel = MsgMenuCourseApplications
|
||||
, navRoute = CourseR tid ssh csh CApplicationsR
|
||||
, navAccess' = NavAccessDB $
|
||||
let courseWhere course = course <$ do
|
||||
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
|
||||
existsApplications = E.selectExists . E.from $ \(course `E.InnerJoin` courseApplication) -> do
|
||||
E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
|
||||
void $ courseWhere course
|
||||
courseApplications = fmap (any E.unValue) . E.select . E.from $ \course -> do
|
||||
void $ courseWhere course
|
||||
return $ course E.^. CourseApplicationsRequired
|
||||
courseAllocation = E.selectExists . E.from $ \(course `E.InnerJoin` allocationCourse) -> do
|
||||
E.on $ course E.^. CourseId E.==. allocationCourse E.^. AllocationCourseCourse
|
||||
void $ courseWhere course
|
||||
in courseAllocation `or2M` courseApplications `or2M` existsApplications
|
||||
, navType = NavTypeLink { navModal = False }
|
||||
, navQuick' = navQuick NavQuickViewPageActionSecondary <> navQuick NavQuickViewFavourite
|
||||
, navForceActive = False
|
||||
}
|
||||
, navChildren = []
|
||||
}
|
||||
]
|
||||
pageActions (CourseR tid ssh csh MaterialListR) = return
|
||||
[ NavPageActionPrimary
|
||||
@ -2212,44 +1998,6 @@ pageActions (CSubmissionR tid ssh csh shn cid CorrectionR) = return
|
||||
}
|
||||
}
|
||||
]
|
||||
pageActions (CourseR tid ssh csh CApplicationsR) = return
|
||||
[ NavPageActionPrimary
|
||||
{ navLink = NavLink
|
||||
{ navLabel = MsgMenuCourseApplicationsFiles
|
||||
, navRoute = CourseR tid ssh csh CAppsFilesR
|
||||
, navAccess' = NavAccessDB $
|
||||
let appAccess (E.Value appId) = do
|
||||
cID <- encrypt appId
|
||||
hasReadAccessTo $ CApplicationR tid ssh csh cID CAFilesR
|
||||
appSource = E.selectSource . E.from $ \(course `E.InnerJoin` courseApplication) -> do
|
||||
E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
|
||||
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.where_ . E.exists . E.from $ \courseApplicationFile ->
|
||||
E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. courseApplication E.^. CourseApplicationId
|
||||
return $ courseApplication E.^. CourseApplicationId
|
||||
in runConduit $ appSource .| anyMC appAccess
|
||||
, navType = NavTypeLink { navModal = False }
|
||||
, navQuick' = mempty
|
||||
, navForceActive = False
|
||||
}
|
||||
, navChildren = []
|
||||
}
|
||||
, NavPageActionPrimary
|
||||
{ navLink = NavLink
|
||||
{ navLabel = MsgMenuCourseMembers
|
||||
, navRoute = CourseR tid ssh csh CUsersR
|
||||
, navAccess' = NavAccessDB $ do
|
||||
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
exists [ CourseParticipantCourse ==. cid ]
|
||||
, navType = NavTypeLink { navModal = False }
|
||||
, navQuick' = mempty
|
||||
, navForceActive = False
|
||||
}
|
||||
, navChildren = []
|
||||
}
|
||||
]
|
||||
pageActions CorrectionsR = return
|
||||
[ NavPageActionPrimary
|
||||
{ navLink = NavLink
|
||||
|
||||
@ -40,13 +40,10 @@ deriving instance Generic MaterialR
|
||||
deriving instance Generic TutorialR
|
||||
deriving instance Generic ExamR
|
||||
deriving instance Generic EExamR
|
||||
deriving instance Generic CourseApplicationR
|
||||
deriving instance Generic AllocationR
|
||||
deriving instance Generic SchoolR
|
||||
deriving instance Generic ExamOfficeR
|
||||
deriving instance Generic CourseNewsR
|
||||
deriving instance Generic CourseEventR
|
||||
deriving instance Generic AMatchingR
|
||||
deriving instance Generic (Route UniWorX)
|
||||
|
||||
|
||||
@ -57,19 +54,16 @@ instance Hashable MaterialR
|
||||
instance Hashable TutorialR
|
||||
instance Hashable ExamR
|
||||
instance Hashable EExamR
|
||||
instance Hashable CourseApplicationR
|
||||
instance Hashable AllocationR
|
||||
instance Hashable SchoolR
|
||||
instance Hashable ExamOfficeR
|
||||
instance Hashable CourseNewsR
|
||||
instance Hashable CourseEventR
|
||||
instance Hashable AMatchingR
|
||||
instance Hashable (Route UniWorX)
|
||||
instance Hashable (Route EmbeddedStatic) where
|
||||
hashWithSalt s = hashWithSalt s . renderRoute
|
||||
instance Hashable (Route Auth) where
|
||||
hashWithSalt s = hashWithSalt s . renderRoute
|
||||
|
||||
|
||||
instance Ord (Route Auth) where
|
||||
compare = compare `on` renderRoute
|
||||
instance Ord (Route EmbeddedStatic) where
|
||||
@ -82,13 +76,10 @@ deriving instance Ord MaterialR
|
||||
deriving instance Ord TutorialR
|
||||
deriving instance Ord ExamR
|
||||
deriving instance Ord EExamR
|
||||
deriving instance Ord CourseApplicationR
|
||||
deriving instance Ord AllocationR
|
||||
deriving instance Ord SchoolR
|
||||
deriving instance Ord ExamOfficeR
|
||||
deriving instance Ord CourseNewsR
|
||||
deriving instance Ord CourseEventR
|
||||
deriving instance Ord AMatchingR
|
||||
deriving instance Ord (Route UniWorX)
|
||||
|
||||
data RouteChildren
|
||||
@ -124,10 +115,6 @@ pattern CSubmissionR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Cr
|
||||
pattern CSubmissionR tid ssh csh shn cid ptn
|
||||
= CSheetR tid ssh csh shn (SubmissionR cid ptn)
|
||||
|
||||
pattern CApplicationR :: TermId -> SchoolId -> CourseShorthand -> CryptoFileNameCourseApplication -> CourseApplicationR -> Route UniWorX
|
||||
pattern CApplicationR tid ssh csh appId ptn
|
||||
= CourseR tid ssh csh (CourseApplicationR appId ptn)
|
||||
|
||||
pattern CNewsR :: TermId -> SchoolId -> CourseShorthand -> CryptoUUIDCourseNews -> CourseNewsR -> Route UniWorX
|
||||
pattern CNewsR tid ssh csh nId ptn
|
||||
= CourseR tid ssh csh (CourseNewsR nId ptn)
|
||||
|
||||
@ -164,12 +164,9 @@ siteLayout' overrideHeading widget = do
|
||||
(favourites', (title, parents), nav', contentHeadline, mmsgs, maxFavouriteTerms, currentTheme, storedReasonAndToggleRoute) <- do
|
||||
|
||||
(favCourses, breadcrumbs'', nav', contentHeadline, mmsgs, storedReasonAndToggleRoute) <- runDB $ do
|
||||
favCourses'' <- withReaderT (projectBackend @SqlReadBackend) . E.select . E.from $ \(course `E.LeftOuterJoin` allocation `E.LeftOuterJoin` courseFavourite) -> do
|
||||
favCourses'' <- withReaderT (projectBackend @SqlReadBackend) . E.select . E.from $ \(course `E.LeftOuterJoin` courseFavourite) -> do
|
||||
E.on $ E.just (course E.^. CourseId) E.==. courseFavourite E.?. CourseFavouriteCourse
|
||||
E.&&. courseFavourite E.?. CourseFavouriteUser E.==. E.val (view _1 <$> muid)
|
||||
E.on . E.exists . E.from $ \allocationCourse ->
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.&&. E.just (allocationCourse E.^. AllocationCourseAllocation) E.==. allocation E.?. AllocationId
|
||||
|
||||
let isFavourite = E.not_ . E.isNothing $ courseFavourite E.?. CourseFavouriteId
|
||||
isCurrent
|
||||
@ -198,7 +195,7 @@ siteLayout' overrideHeading widget = do
|
||||
E.&&. tutorial E.^. TutorialCourse E.==. course E.^. CourseId
|
||||
E.where_ $ E.just (tutor E.^. TutorUser) E.==. E.val (view _1 <$> muid)
|
||||
isAssociated = isParticipant E.||. isLecturer E.||. isCorrector E.||. isTutor
|
||||
courseVisible = courseIsVisible now course $ allocation E.?. AllocationId
|
||||
courseVisible = courseIsVisible now course
|
||||
|
||||
reason = E.case_
|
||||
[ E.when_ isCurrent E.then_ . E.just $ E.val FavouriteCurrent
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
@ -210,7 +210,6 @@ routeNormalizers :: forall m backend.
|
||||
routeNormalizers = map (hoist (hoist liftHandler . withReaderT projectBackend) .)
|
||||
[ normalizeRender
|
||||
, ncSchool
|
||||
, ncAllocation
|
||||
, ncCourse
|
||||
, ncSheet
|
||||
, ncMaterial
|
||||
@ -218,10 +217,8 @@ routeNormalizers = map (hoist (hoist liftHandler . withReaderT projectBackend) .
|
||||
, ncExam
|
||||
, ncExternalExam
|
||||
, verifySubmission
|
||||
, verifyCourseApplication
|
||||
, verifyCourseNews
|
||||
, verifyMaterialVideo
|
||||
, verifyAllocationMatchingLog
|
||||
]
|
||||
where
|
||||
normalizeRender :: Route UniWorX -> WriterT Any (ReaderT SqlReadBackend (HandlerFor UniWorX)) (Route UniWorX)
|
||||
@ -253,11 +250,6 @@ routeNormalizers = map (hoist (hoist liftHandler . withReaderT projectBackend) .
|
||||
Entity ssh' _ <- MaybeT . lift . getBy $ UniqueSchoolShorthand schoolShort
|
||||
(caseChanged `on` unSchoolKey) ssh ssh'
|
||||
return ssh'
|
||||
ncAllocation = maybeOrig $ \route -> do
|
||||
AllocationR tid ssh ash _ <- return route
|
||||
Entity _ Allocation{..} <- MaybeT . $cachedHereBinary (tid, ssh, ash) . lift . getBy $ TermSchoolAllocationShort tid ssh ash
|
||||
caseChanged ash allocationShorthand
|
||||
return $ route & typesUsing @RouteChildren @AllocationShorthand . filtered (== ash) .~ allocationShorthand
|
||||
ncCourse = maybeOrig $ \route -> do
|
||||
CourseR tid ssh csh _ <- return route
|
||||
Entity _ Course{..} <- MaybeT . $cachedHereBinary (tid, ssh, csh) . lift . getBy $ TermSchoolCourseShort tid ssh csh
|
||||
@ -304,14 +296,6 @@ routeNormalizers = map (hoist (hoist liftHandler . withReaderT projectBackend) .
|
||||
let newRoute = CSubmissionR courseTerm courseSchool courseShorthand sheetName cID sr
|
||||
tell . Any $ route /= newRoute
|
||||
return newRoute
|
||||
verifyCourseApplication = maybeOrig $ \route -> do
|
||||
CApplicationR _tid _ssh _csh cID sr <- return route
|
||||
aId <- decrypt cID
|
||||
CourseApplication{courseApplicationCourse} <- lift . lift $ get404 aId
|
||||
Course{courseTerm, courseSchool, courseShorthand} <- lift . lift $ get404 courseApplicationCourse
|
||||
let newRoute = CApplicationR courseTerm courseSchool courseShorthand cID sr
|
||||
tell . Any $ route /= newRoute
|
||||
return newRoute
|
||||
verifyCourseNews = maybeOrig $ \route -> do
|
||||
CNewsR _tid _ssh _csh cID sr <- return route
|
||||
aId <- decrypt cID
|
||||
@ -329,11 +313,3 @@ routeNormalizers = map (hoist (hoist liftHandler . withReaderT projectBackend) .
|
||||
let newRoute = CMaterialR courseTerm courseSchool courseShorthand materialName $ MVideoR cID
|
||||
tell . Any $ route /= newRoute
|
||||
return newRoute
|
||||
verifyAllocationMatchingLog = maybeOrig $ \route -> do
|
||||
AllocationR _tid _ssh _ash (AMatchingR cID AMLogR) <- return route
|
||||
amId <- decrypt cID
|
||||
AllocationMatching{allocationMatchingAllocation} <- lift . lift $ get404 amId
|
||||
Allocation{allocationTerm, allocationSchool, allocationShorthand} <- lift . lift $ get404 allocationMatchingAllocation
|
||||
let newRoute = AllocationR allocationTerm allocationSchool allocationShorthand $ AMatchingR cID AMLogR
|
||||
tell . Any $ route /= newRoute
|
||||
return newRoute
|
||||
|
||||
@ -1,22 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Handler.Allocation
|
||||
( module Handler.Allocation
|
||||
) where
|
||||
|
||||
import Handler.Allocation.Info as Handler.Allocation
|
||||
import Handler.Allocation.Show as Handler.Allocation
|
||||
import Handler.Allocation.Application as Handler.Allocation
|
||||
import Handler.Allocation.Register as Handler.Allocation
|
||||
import Handler.Allocation.List as Handler.Allocation
|
||||
import Handler.Allocation.Users as Handler.Allocation
|
||||
import Handler.Allocation.AddUser as Handler.Allocation
|
||||
import Handler.Allocation.EditUser as Handler.Allocation
|
||||
import Handler.Allocation.Prios as Handler.Allocation
|
||||
import Handler.Allocation.Compute as Handler.Allocation
|
||||
import Handler.Allocation.Accept as Handler.Allocation
|
||||
import Handler.Allocation.Edit as Handler.Allocation
|
||||
import Handler.Allocation.New as Handler.Allocation
|
||||
import Handler.Allocation.Matchings as Handler.Allocation
|
||||
@ -1,170 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Handler.Allocation.Accept
|
||||
( SessionDataAllocationResults(..)
|
||||
, AllocationAcceptButton(..)
|
||||
, allocationAcceptForm
|
||||
, getAAcceptR, postAAcceptR
|
||||
) where
|
||||
|
||||
import Import
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Allocation
|
||||
|
||||
import Data.Ratio ((%))
|
||||
import Data.Map ((!?))
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Control.Monad.State.Class as State
|
||||
|
||||
import Data.Sequence (Seq((:|>)))
|
||||
|
||||
|
||||
newtype SessionDataAllocationResults = SessionDataAllocationResults
|
||||
{ getSessionDataAllocationResults :: Map ( TermId
|
||||
, SchoolId
|
||||
, AllocationShorthand
|
||||
)
|
||||
( UTCTime
|
||||
, AllocationFingerprint
|
||||
, Set CourseId
|
||||
, Set (UserId, CourseId)
|
||||
, Seq MatchingLogRun
|
||||
)
|
||||
} deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
deriving newtype (ToJSON, FromJSON)
|
||||
deriving (Monoid, Semigroup) via Dual (Map (TermId, SchoolId, AllocationShorthand) (UTCTime, AllocationFingerprint, Set CourseId, Set (UserId, CourseId), Seq MatchingLogRun))
|
||||
|
||||
makeWrapped ''SessionDataAllocationResults
|
||||
|
||||
|
||||
data AllocationAcceptButton
|
||||
= BtnAllocationAccept
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
deriving anyclass (Universe, Finite)
|
||||
|
||||
nullaryPathPiece ''AllocationAcceptButton $ camelToPathPiece' 2
|
||||
embedRenderMessage ''UniWorX ''AllocationAcceptButton id
|
||||
|
||||
instance Button UniWorX AllocationAcceptButton where
|
||||
btnClasses BtnAllocationAccept = [BCIsButton, BCPrimary]
|
||||
|
||||
|
||||
allocationAcceptForm :: AllocationId -> DB (Maybe (Form (UTCTime, AllocationFingerprint, Set CourseId, Set (UserId, CourseId), Seq MatchingLogRun)))
|
||||
allocationAcceptForm aId = runMaybeT $ do
|
||||
Allocation{..} <- MaybeT $ get aId
|
||||
SessionDataAllocationResults allocMap <- MaybeT $ lookupSessionJson SessionAllocationResults
|
||||
allocRes@(allocTime, allocFp, eligibleCourses, allocMatching, _ :|> MatchingLogRun{..}) <- hoistMaybe $ allocMap !? (allocationTerm, allocationSchool, allocationShorthand)
|
||||
|
||||
allocationUsers <- fmap (map $ bimap E.unValue E.unValue) . lift . E.select . E.from $ \allocationUser -> do
|
||||
E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. E.val aId
|
||||
E.&&. E.not_ (E.isNothing $ allocationUser E.^. AllocationUserPriority)
|
||||
let applications = E.subSelectCount . E.from $ \courseApplication ->
|
||||
E.where_ $ courseApplication E.^. CourseApplicationAllocation E.==. E.val (Just aId)
|
||||
E.&&. courseApplication E.^. CourseApplicationUser E.==. allocationUser E.^. AllocationUserUser
|
||||
return . (allocationUser E.^. AllocationUserUser, ) $ E.case_
|
||||
[ E.when_ (E.castNum (allocationUser E.^. AllocationUserTotalCourses) E.>. applications)
|
||||
E.then_ (applications :: E.SqlExpr (E.Value Int))
|
||||
]
|
||||
(E.else_ . E.castNum $ allocationUser E.^. AllocationUserTotalCourses)
|
||||
let allocationPlacesRequested = sumOf (folded . _2) allocationUsers
|
||||
userAllocations = ofoldr (\(uid, _cid) -> Map.insertWith (+) uid 1) Map.empty allocMatching
|
||||
|
||||
allocationUsers' <- hoistMaybe $
|
||||
let (res, leftoverAllocs) = foldr (\user@(uid, _) (acc, allocCounts)
|
||||
-> ( (user, Map.findWithDefault 0 uid allocCounts) : acc
|
||||
, Map.delete uid allocCounts
|
||||
))
|
||||
([] , userAllocations) allocationUsers
|
||||
in guardOn (null leftoverAllocs) res :: Maybe [((UserId, Int), Integer)]
|
||||
|
||||
let unmatchedUsers = olength $ filter ((<= 0) . view _2) allocationUsers'
|
||||
|
||||
allocationCourses <- fmap (map $ over _3 E.unValue) . lift . E.select . E.from $ \(allocationCourse `E.InnerJoin` course) -> do
|
||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
|
||||
let participants = E.subSelectCount . E.from $ \courseParticipant ->
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
||||
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
return (allocationCourse, course, participants)
|
||||
let allocationCapacity = sumOf (folded . _2 . _entityVal . _courseCapacity . _Just) allocationCourses
|
||||
allocCourses = setOf (folded . _1 . _entityVal . _allocationCourseCourse) allocationCourses
|
||||
|
||||
let courseAllocations = ofoldr (\(_uid, cid) -> Map.insertWith (+) cid 1) Map.empty allocMatching
|
||||
allocationCourses' <- hoistMaybe $
|
||||
let (res, leftoverAllocs) = foldr (\course@(_, Entity cid _, _) (acc, allocCounts)
|
||||
-> ( (course, Map.findWithDefault 0 cid allocCounts) : acc
|
||||
, Map.delete cid allocCounts
|
||||
))
|
||||
([] , courseAllocations) allocationCourses
|
||||
in guardOn (null leftoverAllocs) res :: Maybe [((Entity AllocationCourse, Entity Course, Int), Int)]
|
||||
|
||||
let unmatchedCourses = olength $ filter ((<= 0) . view _2) allocationCourses'
|
||||
|
||||
let validateMatches =
|
||||
guardValidation MsgAllocationAcceptFormDoesNotMatchSession =<< State.get
|
||||
|
||||
return . set (mapped . mapped . _1 . mapped) allocRes . validateForm validateMatches . identifyForm FIDAllocationAccept $ \csrf -> do
|
||||
(prevAllocRes, prevAllocView) <- mreq hiddenField "" $ Just allocFp
|
||||
let prevAllocMatches = (== allocFp) <$> prevAllocRes
|
||||
|
||||
let
|
||||
showTerms
|
||||
| [_] <- nubOrdOn (view $ _1 . _2 . _entityVal . _courseTerm) allocationCourses'
|
||||
= False
|
||||
| otherwise
|
||||
= True
|
||||
showSchools
|
||||
| [_] <- nubOrdOn (view $ _1 . _2 . _entityVal . _courseSchool) allocationCourses'
|
||||
= False
|
||||
| otherwise
|
||||
= True
|
||||
optimumAllocated = round . (* optimumProportion) . fromIntegral
|
||||
where optimumProportion :: Rational
|
||||
optimumProportion
|
||||
| allocationCapacity > 0 = fromIntegral allocationPlacesRequested % fromIntegral allocationCapacity
|
||||
| otherwise = 0
|
||||
allocHeat capN
|
||||
= invDualHeat (optimumAllocated capN) capN
|
||||
degenerateHeat capN
|
||||
= capN <= optimumAllocated capN
|
||||
|
||||
return (prevAllocMatches, $(widgetFile "allocation/accept"))
|
||||
|
||||
getAAcceptR, postAAcceptR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
|
||||
getAAcceptR = postAAcceptR
|
||||
postAAcceptR tid ssh ash = do
|
||||
(((_, acceptView), acceptEnctype), didStore) <- runDB $ do
|
||||
aId <- getKeyBy404 $ TermSchoolAllocationShort tid ssh ash
|
||||
|
||||
acceptForm <- maybe (redirect $ AllocationR tid ssh ash AComputeR) return =<< allocationAcceptForm aId
|
||||
|
||||
formRes@((acceptRes, _), _) <- liftHandler $ runFormPost acceptForm
|
||||
|
||||
didStore <- formResultMaybe acceptRes $ \(now, allocFp, _, allocMatchings, allocLog) -> do
|
||||
modifySessionJson SessionAllocationResults . fmap (assertM $ not . views _Wrapped onull) . over (mapped . _Wrapped :: Setter' (Maybe SessionDataAllocationResults) _) $
|
||||
Map.filterWithKey (\(tid', ssh', ash') (_, allocFp', _, _, _) ->
|
||||
or [ tid' /= tid
|
||||
, ssh' /= ssh
|
||||
, ash' /= ash
|
||||
, allocFp' /= allocFp
|
||||
])
|
||||
storeAllocationResult aId now (allocFp, allocMatchings, allocLog)
|
||||
return $ Just ()
|
||||
|
||||
return (formRes, is _Just didStore)
|
||||
|
||||
when didStore $ do
|
||||
addMessageI Success MsgAllocationAccepted
|
||||
redirect $ AllocationR tid ssh ash AUsersR
|
||||
|
||||
siteLayoutMsg MsgHeadingAllocationAccept $ do
|
||||
setTitleI MsgHeadingAllocationAccept
|
||||
|
||||
wrapForm' BtnAllocationAccept acceptView def
|
||||
{ formEncoding = acceptEnctype
|
||||
}
|
||||
@ -1,89 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Handler.Allocation.AddUser
|
||||
( getAAddUserR, postAAddUserR
|
||||
) where
|
||||
|
||||
import Import
|
||||
import Handler.Allocation.Application
|
||||
import Handler.Allocation.UserForm
|
||||
|
||||
import Handler.Utils
|
||||
|
||||
import qualified Data.Map.Strict as Map
|
||||
|
||||
import qualified Data.Conduit.Combinators as C
|
||||
|
||||
|
||||
getAAddUserR, postAAddUserR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
|
||||
getAAddUserR = postAAddUserR
|
||||
postAAddUserR tid ssh ash = do
|
||||
(Entity _ Allocation{..}, (addUserAct, addUserForm, addUserEnctype)) <- runDB $ do
|
||||
alloc@(Entity aId _) <- getBy404 $ TermSchoolAllocationShort tid ssh ash
|
||||
|
||||
((addUserRes, addUserForm), addUserEnctype) <- runFormPost . renderAForm FormStandard $
|
||||
allocationUserForm aId Nothing
|
||||
|
||||
addUserAct <- formResultMaybe addUserRes $ \AllocationUserForm{..} -> Just <$> do
|
||||
now <- liftIO getCurrentTime
|
||||
|
||||
didInsert <- is _Just <$> insertUnique AllocationUser
|
||||
{ allocationUserAllocation = aId
|
||||
, allocationUserUser = aauUser
|
||||
, allocationUserTotalCourses = aauTotalCourses
|
||||
, allocationUserPriority = aauPriority
|
||||
}
|
||||
|
||||
if
|
||||
| didInsert -> do
|
||||
oldApps <- selectList [CourseApplicationUser ==. aauUser, CourseApplicationAllocation ==. Just aId] []
|
||||
forM_ oldApps $ \(Entity appId CourseApplication{..}) -> do
|
||||
deleteWhere [ CourseApplicationFileApplication ==. appId ]
|
||||
delete appId
|
||||
unless (courseApplicationCourse `Map.member` aauApplications) $
|
||||
audit $ TransactionCourseApplicationDeleted courseApplicationCourse courseApplicationUser appId
|
||||
|
||||
iforM_ aauApplications $ \cId ApplicationForm{..} -> maybeT_ $ do
|
||||
prio <- hoistMaybe afPriority
|
||||
let rated = afRatingVeto || is _Just afRatingPoints
|
||||
appId <- lift $ insert CourseApplication
|
||||
{ courseApplicationCourse = cId
|
||||
, courseApplicationUser = aauUser
|
||||
, courseApplicationText = afText
|
||||
, courseApplicationRatingVeto = afRatingVeto
|
||||
, courseApplicationRatingPoints = afRatingPoints
|
||||
, courseApplicationRatingComment = afRatingComment
|
||||
, courseApplicationAllocation = Just aId
|
||||
, courseApplicationAllocationPriority = Just prio
|
||||
, courseApplicationTime = now
|
||||
, courseApplicationRatingTime = guardOn rated now
|
||||
}
|
||||
lift . runConduit $ transPipe liftHandler (sequence_ afFiles) .| C.mapM_ (insert_ . review _FileReference . (, CourseApplicationFileResidual appId))
|
||||
lift . audit $ TransactionCourseApplicationEdit cId aauUser appId
|
||||
|
||||
return $ do
|
||||
addMessageI Success MsgAllocationAddUserUserAdded
|
||||
redirect $ AllocationR tid ssh ash AAddUserR
|
||||
| otherwise -> return $ addMessageI Error MsgAllocationAddUserUserExists
|
||||
|
||||
return (alloc, (addUserAct, addUserForm, addUserEnctype))
|
||||
|
||||
sequence_ addUserAct
|
||||
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
let title = MsgAllocationAddUserTitle (mr . ShortTermIdentifier $ unTermKey allocationTerm) (unSchoolKey allocationSchool) allocationName
|
||||
shortTitle = MsgAllocationAddUserShortTitle allocationTerm allocationSchool allocationShorthand
|
||||
|
||||
siteLayoutMsg title $ do
|
||||
setTitleI shortTitle
|
||||
wrapForm addUserForm FormSettings
|
||||
{ formMethod = POST
|
||||
, formAction = Just . SomeRoute $ AllocationR tid ssh ash AAddUserR
|
||||
, formEncoding = addUserEnctype
|
||||
, formAttrs = []
|
||||
, formSubmit = FormSubmit
|
||||
, formAnchor = Nothing :: Maybe Text
|
||||
}
|
||||
|
||||
@ -1,385 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Handler.Allocation.Application
|
||||
( AllocationApplicationButton(..)
|
||||
, ApplicationFormView(..)
|
||||
, ApplicationForm(..)
|
||||
, ApplicationFormMode(..)
|
||||
, ApplicationFormException(..)
|
||||
, applicationForm, editApplicationR
|
||||
, postAApplyR
|
||||
) where
|
||||
|
||||
import Import hiding (hash)
|
||||
|
||||
import Handler.Utils
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
|
||||
data AllocationApplicationButton
|
||||
= BtnAllocationApply
|
||||
| BtnAllocationApplicationEdit
|
||||
| BtnAllocationApplicationRetract
|
||||
| BtnAllocationApplicationRate
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Universe AllocationApplicationButton
|
||||
instance Finite AllocationApplicationButton
|
||||
|
||||
nullaryPathPiece ''AllocationApplicationButton $ camelToPathPiece' 1
|
||||
embedRenderMessage ''UniWorX ''AllocationApplicationButton id
|
||||
makePrisms ''AllocationApplicationButton
|
||||
|
||||
instance Button UniWorX AllocationApplicationButton where
|
||||
btnLabel BtnAllocationApply = [whamlet|#{iconApply True} _{MsgBtnAllocationApply}|]
|
||||
btnLabel BtnAllocationApplicationRetract = [whamlet|#{iconApply False} _{MsgBtnAllocationApplicationRetract}|]
|
||||
btnLabel BtnAllocationApplicationEdit = [whamlet|#{iconAllocationApplicationEdit} _{MsgBtnAllocationApplicationEdit}|]
|
||||
btnLabel BtnAllocationApplicationRate = i18n BtnAllocationApplicationRate
|
||||
|
||||
btnClasses BtnAllocationApplicationRetract = [BCIsButton, BCDanger]
|
||||
btnClasses _ = [BCIsButton, BCPrimary]
|
||||
|
||||
|
||||
data ApplicationFormView = ApplicationFormView
|
||||
{ afvPriority :: Maybe (FieldView UniWorX)
|
||||
, afvForm :: [FieldView UniWorX]
|
||||
, afvButtons :: ([AllocationApplicationButton], Widget)
|
||||
}
|
||||
|
||||
data ApplicationForm = ApplicationForm
|
||||
{ afPriority :: Maybe Word64
|
||||
, afText :: Maybe Text
|
||||
, afFiles :: Maybe FileUploads
|
||||
, afRatingVeto :: Bool
|
||||
, afRatingPoints :: Maybe ExamGrade
|
||||
, afRatingComment :: Maybe Text
|
||||
, afAction :: AllocationApplicationButton
|
||||
}
|
||||
|
||||
data ApplicationFormMode = ApplicationFormMode
|
||||
{ afmApplicant :: Bool -- ^ Show priority
|
||||
, afmApplicantEdit :: Bool -- ^ Allow editing text, files, priority (if shown)
|
||||
, afmLecturer :: Bool -- ^ Allow editing rating
|
||||
}
|
||||
|
||||
|
||||
data ApplicationFormException = ApplicationFormNoApplication -- ^ Could not fill forced fields of application form with data from application
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
instance Exception ApplicationFormException
|
||||
|
||||
applicationForm :: Maybe AllocationId
|
||||
-> CourseId
|
||||
-> Maybe UserId
|
||||
-> ApplicationFormMode -- ^ Which parts of the shared form to display
|
||||
-> Maybe Html -- ^ If @Just@ also include action buttons for usage as standalone form
|
||||
-> MForm Handler (FormResult ApplicationForm, ApplicationFormView)
|
||||
applicationForm maId@(is _Just -> isAlloc) cid muid ApplicationFormMode{..} mcsrf = do
|
||||
|
||||
(mApp, coursesNum, Course{..}, maxPrio) <- liftHandler . runDB $ do
|
||||
mApplication <- fmap join . for muid $ \uid -> listToMaybe <$> selectList [CourseApplicationAllocation ==. maId, CourseApplicationUser ==. uid, CourseApplicationCourse ==. cid] [LimitTo 1]
|
||||
coursesNum <- fromIntegral . fromMaybe 1 <$> for maId (\aId -> count [AllocationCourseAllocation ==. aId])
|
||||
course <- getJust cid
|
||||
(fromMaybe 0 -> maxPrio) <- fmap join . for muid $ \uid -> fmap (E.unValue <=< listToMaybe) . E.select . E.from $ \courseApplication -> do
|
||||
E.where_ $ courseApplication E.^. CourseApplicationUser E.==. E.val uid
|
||||
E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.val maId
|
||||
E.&&. E.not_ (E.isNothing $ courseApplication E.^. CourseApplicationAllocationPriority)
|
||||
return . E.joinV . E.max_ $ courseApplication E.^. CourseApplicationAllocationPriority
|
||||
return (mApplication, coursesNum, course, maxPrio)
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
|
||||
let
|
||||
oldPrio :: Maybe Word64
|
||||
oldPrio = mApp >>= courseApplicationAllocationPriority . entityVal
|
||||
|
||||
coursesNum' = succ maxPrio `max` coursesNum
|
||||
|
||||
mkPrioOption :: Word64 -> Option Word64
|
||||
mkPrioOption i = Option
|
||||
{ optionDisplay = mr . MsgAllocationCoursePriority . fromIntegral $ coursesNum' - i
|
||||
, optionInternalValue = i
|
||||
, optionExternalValue = tshow i
|
||||
}
|
||||
|
||||
prioOptions :: OptionList Word64
|
||||
prioOptions = OptionList
|
||||
{ olOptions = sortOn (Down . optionInternalValue) . map mkPrioOption $ [0 .. pred coursesNum']
|
||||
, olReadExternal = readMay
|
||||
}
|
||||
prioField = selectField' (Just $ SomeMessage MsgAllocationCourseNoApplication) $ return prioOptions
|
||||
|
||||
(prioRes, prioView) <- case (isAlloc, afmApplicant, afmApplicantEdit, mApp) of
|
||||
(True , True , True , _)
|
||||
| is _Nothing mApp || is _Nothing mcsrf
|
||||
-> over _2 Just <$> mopt prioField (fslI MsgApplicationPriority) (Just oldPrio)
|
||||
(True , True , True , Just _ )
|
||||
-> over (_1 . _FormSuccess) Just . over _2 Just <$> mreq prioField (fslI MsgApplicationPriority) oldPrio
|
||||
(True , True , False, _ )
|
||||
-> over _2 Just <$> mforcedOpt prioField (fslI MsgApplicationPriority) oldPrio
|
||||
(True , False, _ , Just _ )
|
||||
| is _Just oldPrio
|
||||
-> pure (FormSuccess oldPrio, Nothing)
|
||||
(True , _ , _ , _ )
|
||||
-> throwM ApplicationFormNoApplication
|
||||
(False, _ , _ , _ )
|
||||
-> pure (FormSuccess Nothing, Nothing)
|
||||
|
||||
let textField' = convertField (Text.strip . unTextarea) Textarea textareaField
|
||||
textFs
|
||||
| is _Just courseApplicationsInstructions
|
||||
= fslI MsgCourseApplicationText & setTooltip MsgCourseApplicationFollowInstructions
|
||||
| otherwise
|
||||
= fslI MsgCourseApplicationText
|
||||
(textRes, textView) <- if
|
||||
| not courseApplicationsText
|
||||
-> pure (FormSuccess Nothing, Nothing)
|
||||
| not afmApplicantEdit
|
||||
-> over _2 Just <$> mforcedOpt textField' textFs (mApp >>= courseApplicationText . entityVal)
|
||||
| otherwise
|
||||
-> over _2 Just . over (_1 . _FormSuccess) (assertM $ not . Text.null) <$> mopt textField' textFs (Just $ mApp >>= courseApplicationText . entityVal)
|
||||
|
||||
appFilesInfo <- for mApp $ \(Entity appId _) -> liftHandler . runDB $ do
|
||||
hasFiles <- exists [ CourseApplicationFileApplication ==. appId ]
|
||||
appCID <- encrypt appId
|
||||
appFilesLink <- toTextUrl $ CApplicationR courseTerm courseSchool courseShorthand appCID CAFilesR
|
||||
return (hasFiles, appFilesLink)
|
||||
let hasFiles = maybe False (view _1) appFilesInfo
|
||||
|
||||
filesLinkView <- if
|
||||
| hasFiles || (isn't _NoUpload courseApplicationsFiles && not afmApplicantEdit)
|
||||
-> let filesLinkField = Field{..}
|
||||
where
|
||||
fieldParse _ _ = return $ Right Nothing
|
||||
fieldEnctype = mempty
|
||||
fieldView theId _ attrs _ _
|
||||
= [whamlet|
|
||||
$newline never
|
||||
$case appFilesInfo
|
||||
$of Just (True, appFilesLink)
|
||||
<a ##{theId} *{attrs} href=#{appFilesLink}>
|
||||
_{MsgCourseApplicationFiles}
|
||||
$of _
|
||||
<span ##{theId} *{attrs}>
|
||||
_{MsgCourseApplicationNoFiles}
|
||||
|]
|
||||
in Just . snd <$> mforced filesLinkField (fslI MsgCourseApplicationFiles) ()
|
||||
| otherwise
|
||||
-> return Nothing
|
||||
|
||||
filesWarningView <- if
|
||||
| hasFiles && isn't _NoUpload courseApplicationsFiles && afmApplicantEdit
|
||||
-> fmap (Just . snd) . formMessage =<< messageIconI Info IconFileUpload MsgCourseApplicationFilesNeedReupload
|
||||
| otherwise
|
||||
-> return Nothing
|
||||
|
||||
(filesRes, filesView) <-
|
||||
let mkFs = bool MsgCourseApplicationFile MsgCourseApplicationArchive
|
||||
prevAppFiles (Entity aId _) = runDBSource $ selectSource [CourseApplicationFileApplication ==. aId] [Asc CourseApplicationFileTitle] .| C.map (view $ _FileReference . _1)
|
||||
in if
|
||||
| not afmApplicantEdit || is _NoUpload courseApplicationsFiles
|
||||
-> return (FormSuccess Nothing, Nothing)
|
||||
| otherwise
|
||||
-> fmap (over _2 $ Just . ($ [])) . aFormToForm $ fileUploadForm False (fslI . mkFs) courseApplicationsFiles (prevAppFiles <$> mApp)
|
||||
|
||||
(vetoRes, vetoView) <- if
|
||||
| afmLecturer
|
||||
-> over _2 Just <$> mpopt checkBoxField (fslI MsgApplicationVeto & setTooltip MsgApplicationVetoTip) (Just $ Just True == fmap (courseApplicationRatingVeto . entityVal) mApp)
|
||||
| otherwise
|
||||
-> return (FormSuccess $ Just True == fmap (courseApplicationRatingVeto . entityVal) mApp, Nothing)
|
||||
|
||||
(pointsRes, pointsView) <- if
|
||||
| afmLecturer
|
||||
-> over _2 Just <$> mopt examGradeField (fslI MsgApplicationRatingPoints & setTooltip MsgApplicationRatingPointsTip) (fmap Just $ mApp >>= courseApplicationRatingPoints . entityVal)
|
||||
| otherwise
|
||||
-> return (FormSuccess $ courseApplicationRatingPoints . entityVal =<< mApp, Nothing)
|
||||
|
||||
(commentRes, commentView) <- if
|
||||
| afmLecturer
|
||||
-> over _2 Just . over (_1 . _FormSuccess) (assertM $ not . Text.null) <$> mopt textField' (fslI MsgApplicationRatingComment & setTooltip (bool MsgApplicationRatingCommentInvisibleTip MsgApplicationRatingCommentVisibleTip courseApplicationsRatingsVisible)) (fmap Just $ mApp >>= courseApplicationRatingComment . entityVal)
|
||||
| otherwise
|
||||
-> return (FormSuccess $ courseApplicationRatingComment . entityVal =<< mApp, Nothing)
|
||||
|
||||
let
|
||||
buttons = catMaybes
|
||||
[ guardOn (not afmApplicantEdit && is _Just mApp && afmLecturer) BtnAllocationApplicationRate
|
||||
, guardOn ( afmApplicantEdit && is _Just mApp ) BtnAllocationApplicationEdit
|
||||
, guardOn ( afmApplicantEdit && is _Nothing mApp ) BtnAllocationApply
|
||||
, guardOn ( afmApplicantEdit && is _Just mApp ) BtnAllocationApplicationRetract
|
||||
]
|
||||
(actionRes, buttonsView) <- case mcsrf of
|
||||
Just csrf -> buttonForm' buttons csrf
|
||||
Nothing -> return (pure BtnAllocationApplicationEdit, mempty)
|
||||
|
||||
ratingSection <- if
|
||||
| afmLecturer
|
||||
, afmApplicantEdit
|
||||
-> Just . set _fvTooltip (Just . toHtml $ mr MsgApplicationRatingSectionSelfTip) . snd <$> formSection MsgApplicationRatingSection
|
||||
| afmLecturer
|
||||
-> Just . snd <$> formSection MsgApplicationRatingSection
|
||||
| otherwise
|
||||
-> return Nothing
|
||||
|
||||
return ( ApplicationForm
|
||||
<$> prioRes
|
||||
<*> textRes
|
||||
<*> filesRes
|
||||
<*> vetoRes
|
||||
<*> pointsRes
|
||||
<*> commentRes
|
||||
<*> actionRes
|
||||
, ApplicationFormView
|
||||
{ afvPriority = prioView
|
||||
, afvForm = catMaybes $
|
||||
[ textView
|
||||
, filesLinkView
|
||||
, filesWarningView
|
||||
] ++ maybe [] (map Just) filesView ++
|
||||
[ ratingSection
|
||||
, vetoView
|
||||
, pointsView
|
||||
, commentView
|
||||
]
|
||||
, afvButtons = (buttons, buttonsView)
|
||||
}
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
editApplicationR :: Maybe AllocationId
|
||||
-> UserId
|
||||
-> CourseId
|
||||
-> Maybe CourseApplicationId
|
||||
-> ApplicationFormMode
|
||||
-> (AllocationApplicationButton -> Bool)
|
||||
-> SomeRoute UniWorX
|
||||
-> Handler (ApplicationFormView, Enctype)
|
||||
editApplicationR maId uid cid mAppId afMode allowAction postAction = do
|
||||
Course{..} <- runDB $ get404 cid
|
||||
|
||||
((appRes, appView), appEnc) <- runFormPost $ applicationForm maId cid (Just uid) afMode . Just
|
||||
|
||||
formResult appRes $ \ApplicationForm{..} -> do
|
||||
if
|
||||
| BtnAllocationApply <- afAction
|
||||
, allowAction afAction
|
||||
, is _Nothing maId || is _Just afPriority
|
||||
-> runDB . setSerializable $ do
|
||||
haveOld <- exists [ CourseApplicationCourse ==. cid
|
||||
, CourseApplicationUser ==. uid
|
||||
, CourseApplicationAllocation ==. maId
|
||||
]
|
||||
when haveOld $
|
||||
invalidArgsI [MsgCourseApplicationExists]
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
let rated = afRatingVeto || is _Just afRatingPoints
|
||||
|
||||
appId <- insert CourseApplication
|
||||
{ courseApplicationCourse = cid
|
||||
, courseApplicationUser = uid
|
||||
, courseApplicationText = afText
|
||||
, courseApplicationRatingVeto = afRatingVeto
|
||||
, courseApplicationRatingPoints = afRatingPoints
|
||||
, courseApplicationRatingComment = afRatingComment
|
||||
, courseApplicationAllocation = maId
|
||||
, courseApplicationAllocationPriority = afPriority
|
||||
, courseApplicationTime = now
|
||||
, courseApplicationRatingTime = guardOn rated now
|
||||
}
|
||||
|
||||
runConduit $ transPipe liftHandler (sequence_ afFiles) .| C.mapM_ (insert_ . review _FileReference . (, CourseApplicationFileResidual appId))
|
||||
audit $ TransactionCourseApplicationEdit cid uid appId
|
||||
addMessageI Success $ MsgCourseApplicationCreated courseShorthand
|
||||
| is _BtnAllocationApplicationEdit afAction || is _BtnAllocationApplicationRate afAction
|
||||
, allowAction afAction
|
||||
, Just appId <- mAppId
|
||||
, is _Nothing maId || is _Just afPriority
|
||||
-> runDB . setSerializable $ do
|
||||
now <- liftIO getCurrentTime
|
||||
|
||||
changes <- if
|
||||
| afmApplicantEdit afMode
|
||||
-> let mkFilter CourseApplicationFileResidual{..} = [ CourseApplicationFileApplication ==. courseApplicationFileResidualApplication ]
|
||||
in view _2 <$> replaceFileReferences mkFilter (CourseApplicationFileResidual appId) (forM_ afFiles id)
|
||||
| otherwise
|
||||
-> return Set.empty
|
||||
|
||||
oldApp <- get404 appId
|
||||
let newApp = oldApp
|
||||
{ courseApplicationText = afText
|
||||
, courseApplicationRatingVeto = afRatingVeto
|
||||
, courseApplicationRatingPoints = afRatingPoints
|
||||
, courseApplicationRatingComment = afRatingComment
|
||||
, courseApplicationAllocation = maId
|
||||
, courseApplicationAllocationPriority = afPriority
|
||||
}
|
||||
|
||||
newRating = any (\f -> f oldApp newApp)
|
||||
[ (/=) `on` courseApplicationRatingVeto
|
||||
, (/=) `on` courseApplicationRatingPoints
|
||||
, (/=) `on` courseApplicationRatingComment
|
||||
]
|
||||
hasRating = any ($ newApp)
|
||||
[ courseApplicationRatingVeto
|
||||
, is _Just . courseApplicationRatingPoints
|
||||
]
|
||||
|
||||
appChanged = any (\f -> f oldApp newApp)
|
||||
[ (/=) `on` courseApplicationText
|
||||
, \_ _ -> not $ Set.null changes
|
||||
]
|
||||
|
||||
newApp' = newApp
|
||||
& bool id (set _courseApplicationRatingTime Nothing) appChanged
|
||||
& bool id (set _courseApplicationRatingTime $ Just now) (newRating && hasRating)
|
||||
& bool id (set _courseApplicationTime now) appChanged
|
||||
replace appId newApp'
|
||||
audit $ TransactionCourseApplicationEdit cid uid appId
|
||||
|
||||
uncurry addMessageI =<< case (afmLecturer afMode, newRating, hasRating, appChanged) of
|
||||
(_, False, _, True) -> return (Success, MsgCourseApplicationEdited courseShorthand)
|
||||
(_, False, _, False) -> return (Info, MsgCourseApplicationNotEdited courseShorthand)
|
||||
(True, True, True, _) -> return (Success, MsgCourseApplicationRated)
|
||||
(True, True, False, _) -> return (Success, MsgCourseApplicationRatingDeleted)
|
||||
(False, True, _, _) -> permissionDenied "rating changed without lecturer rights"
|
||||
| is _BtnAllocationApplicationRetract afAction
|
||||
, allowAction afAction
|
||||
, Just appId <- mAppId
|
||||
-> runDB $ do
|
||||
delete appId
|
||||
audit $ TransactionCourseApplicationDeleted cid uid appId
|
||||
addMessageI Success $ MsgCourseApplicationDeleted courseShorthand
|
||||
| otherwise
|
||||
-> invalidArgsI [MsgCourseApplicationInvalidAction]
|
||||
|
||||
redirect postAction
|
||||
|
||||
return (appView, appEnc)
|
||||
|
||||
|
||||
postAApplyR :: TermId -> SchoolId -> AllocationShorthand -> CryptoUUIDCourse -> Handler Void
|
||||
postAApplyR tid ssh ash cID = do
|
||||
uid <- requireAuthId
|
||||
cid <- decrypt cID
|
||||
(aId, Course{..}) <- runDB $ do
|
||||
aId <- getKeyBy404 $ TermSchoolAllocationShort tid ssh ash
|
||||
course <- get404 cid
|
||||
return (aId, course)
|
||||
|
||||
afmLecturer <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
|
||||
|
||||
let afMode = ApplicationFormMode
|
||||
{ afmApplicant = True
|
||||
, afmApplicantEdit = True
|
||||
, afmLecturer
|
||||
}
|
||||
|
||||
void . editApplicationR (Just aId) uid cid Nothing afMode (== BtnAllocationApply) . SomeRoute $ AllocationR tid ssh ash AShowR :#: cID
|
||||
|
||||
invalidArgs ["Application form required"]
|
||||
@ -1,154 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Handler.Allocation.Compute
|
||||
( getAComputeR
|
||||
, postAComputeR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Allocation
|
||||
import Handler.Allocation.Accept (SessionDataAllocationResults(..))
|
||||
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import qualified Control.Monad.State.Class as State
|
||||
|
||||
|
||||
data AllocationComputeForm = AllocationComputeForm
|
||||
{ acfMissingPrioritiesOk :: Set UserId
|
||||
, acfRestrictCourses :: Maybe (Set CourseId)
|
||||
}
|
||||
|
||||
data AllocationComputeButton
|
||||
= BtnAllocationCompute
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
deriving anyclass (Universe, Finite)
|
||||
|
||||
nullaryPathPiece ''AllocationComputeButton $ camelToPathPiece' 2
|
||||
embedRenderMessage ''UniWorX ''AllocationComputeButton id
|
||||
|
||||
instance Button UniWorX AllocationComputeButton where
|
||||
btnClasses BtnAllocationCompute = [BCIsButton, BCPrimary]
|
||||
|
||||
missingPrioritiesUsers :: AllocationId -> DB (Map UserId User)
|
||||
missingPrioritiesUsers aId = $cachedHereBinary aId $ do
|
||||
usersWithoutPrio <- E.select . E.from $ \(user `E.InnerJoin` allocationUser) -> do
|
||||
E.on $ user E.^. UserId E.==. allocationUser E.^. AllocationUserUser
|
||||
E.&&. allocationUser E.^. AllocationUserAllocation E.==. E.val aId
|
||||
|
||||
-- Ignore users without applications
|
||||
E.where_ . E.exists . E.from $ \courseApplication -> do
|
||||
E.where_ $ courseApplication E.^. CourseApplicationAllocation E.==. E.just (E.val aId)
|
||||
E.&&. courseApplication E.^. CourseApplicationUser E.==. user E.^. UserId
|
||||
E.where_ . E.exists . E.from $ \allocationCourse ->
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. courseApplication E.^. CourseApplicationCourse
|
||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
|
||||
|
||||
E.where_ . E.isNothing $ allocationUser E.^. AllocationUserPriority
|
||||
|
||||
return user
|
||||
|
||||
return $ toMapOf (folded .> _entityVal) usersWithoutPrio
|
||||
|
||||
missingPriorities :: AllocationId -> AForm DB (Set UserId)
|
||||
missingPriorities aId = wFormToAForm $ do
|
||||
usersWithoutPrio <- lift . lift $ missingPrioritiesUsers aId
|
||||
|
||||
let missingPriosField = checkBoxField { fieldView = missingPriosFieldView }
|
||||
where
|
||||
missingPriosFieldView theId name attrs res isReq
|
||||
= $(i18nWidgetFile "allocation-confirm-missing-prios")
|
||||
where checkBoxFieldView = labeledCheckBoxView (i18n MsgAllocationUsersMissingPrioritiesOk) theId name attrs res isReq
|
||||
|
||||
if
|
||||
| null usersWithoutPrio
|
||||
-> return $ pure Set.empty
|
||||
| otherwise
|
||||
-> fmap (bool Set.empty $ Map.keysSet usersWithoutPrio) <$> wpreq missingPriosField (fslI MsgAllocationUsersMissingPriorities & setTooltip MsgAllocationUsersMissingPrioritiesTip) (Just False)
|
||||
|
||||
|
||||
data AllocationCourseRestrictionMode
|
||||
= AllocationCourseRestrictionDontRestrict
|
||||
| AllocationCourseRestrictionSubstitutes
|
||||
| AllocationCourseRestrictionCustom
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
deriving anyclass (Universe, Finite)
|
||||
nullaryPathPiece ''AllocationCourseRestrictionMode $ camelToPathPiece' 3
|
||||
embedRenderMessage ''UniWorX ''AllocationCourseRestrictionMode id
|
||||
|
||||
restrictCourses :: (MonadHandler m, HandlerSite m ~ UniWorX) => AllocationId -> AForm m (Maybe (Set CourseId))
|
||||
restrictCourses aId = hoistAForm liftHandler $ multiActionA restrictOpts (fslI MsgAllocationRestrictCourses & setTooltip MsgAllocationRestrictCoursesTip) (Just AllocationCourseRestrictionDontRestrict)
|
||||
where
|
||||
restrictOpts = mapF $ \case
|
||||
AllocationCourseRestrictionDontRestrict -> pure Nothing
|
||||
AllocationCourseRestrictionSubstitutes -> wFormToAForm $ do
|
||||
now <- liftIO getCurrentTime
|
||||
allocCourses <- fmap (setOf $ folded . _Value) . liftHandler . runDB . E.select . E.from $ \allocationCourse -> do
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
|
||||
E.where_ . E.maybe E.false (E.>=. E.val now) $ allocationCourse E.^. AllocationCourseAcceptSubstitutes
|
||||
return $ allocationCourse E.^. AllocationCourseCourse
|
||||
return . pure $ Just allocCourses
|
||||
AllocationCourseRestrictionCustom -> Just <$> selectCourses
|
||||
selectCourses = courseSelectForm query coursePred miButtonAction' miIdent' fSettings fRequired mPrev
|
||||
where
|
||||
query = E.from $ \(course `E.InnerJoin` allocationCourse) -> do
|
||||
E.on $ course E.^. CourseId E.==. allocationCourse E.^. AllocationCourseCourse
|
||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
|
||||
return course
|
||||
coursePred _ = return True
|
||||
mPrev = Nothing
|
||||
fRequired = True
|
||||
fSettings = fslI MsgAllocationRestrictCoursesSelection & setTooltip MsgAllocationRestrictCoursesSelectionTip
|
||||
miIdent' :: Text
|
||||
miIdent' = "course-selection"
|
||||
miButtonAction' _ = Nothing
|
||||
|
||||
allocationComputeForm :: AllocationId -> AForm DB AllocationComputeForm
|
||||
allocationComputeForm aId = wFormToAForm $ do
|
||||
onlyComputeMsg <- messageI Info MsgAllocationOnlyCompute
|
||||
|
||||
aFormToWForm $ AllocationComputeForm
|
||||
<$ aformMessage onlyComputeMsg
|
||||
<*> missingPriorities aId
|
||||
<*> restrictCourses aId
|
||||
|
||||
validateAllocationComputeForm :: AllocationId -> FormValidator AllocationComputeForm DB ()
|
||||
validateAllocationComputeForm aId = do
|
||||
usersWithoutPrio <- lift $ missingPrioritiesUsers aId
|
||||
|
||||
missingOk <- State.gets acfMissingPrioritiesOk
|
||||
guardValidation MsgAllocationUsersMissingPrioritiesNotOk $
|
||||
Map.keysSet usersWithoutPrio `Set.isSubsetOf` missingOk
|
||||
|
||||
|
||||
getAComputeR, postAComputeR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
|
||||
getAComputeR = postAComputeR
|
||||
postAComputeR tid ssh ash = do
|
||||
(_, ((_computeFormRes, computeFormView), computeFormEnctype)) <- runDB $ do
|
||||
aEnt@(Entity aId _) <- getBy404 $ TermSchoolAllocationShort tid ssh ash
|
||||
formRes@((computeFormRes, _), _) <- runFormPost . validateForm (validateAllocationComputeForm aId) . renderAForm FormStandard $ allocationComputeForm aId
|
||||
|
||||
formResult computeFormRes $ \AllocationComputeForm{..} -> do
|
||||
now <- liftIO getCurrentTime
|
||||
(allocFp, eligibleCourses, allocMatching, allocLog) <- computeAllocation aEnt acfRestrictCourses
|
||||
tellSessionJson SessionAllocationResults . SessionDataAllocationResults $
|
||||
Map.singleton (tid, ssh, ash) (now, allocFp, eligibleCourses, allocMatching, allocLog)
|
||||
addMessageI Success MsgAllocationComputed
|
||||
redirect $ AllocationR tid ssh ash AUsersR -- Redirect aborts transaction for safety
|
||||
|
||||
return (aEnt, formRes)
|
||||
|
||||
siteLayoutMsg MsgHeadingAllocationCompute $ do
|
||||
setTitleI MsgHeadingAllocationCompute
|
||||
|
||||
wrapForm' BtnAllocationCompute computeFormView def
|
||||
{ formEncoding = computeFormEnctype
|
||||
}
|
||||
@ -1,84 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Handler.Allocation.Edit
|
||||
( getAEditR, postAEditR
|
||||
) where
|
||||
|
||||
import Import
|
||||
import Handler.Utils
|
||||
|
||||
import Handler.Allocation.Form
|
||||
|
||||
import qualified Data.Set as Set
|
||||
|
||||
|
||||
getAEditR, postAEditR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
|
||||
getAEditR = postAEditR
|
||||
postAEditR tid ssh ash = do
|
||||
(Allocation{..}, (mAct, (formView, formEnc))) <- runDB $ do
|
||||
Entity aId alloc@Allocation{..} <- getBy404 $ TermSchoolAllocationShort tid ssh ash
|
||||
|
||||
let template = AllocationForm
|
||||
{ afTerm = allocationTerm
|
||||
, afSchool = allocationSchool
|
||||
, afShorthand = allocationShorthand
|
||||
, afName = allocationName
|
||||
, afLegacyShorthands = Set.fromList allocationLegacyShorthands
|
||||
, afDescription = allocationDescription
|
||||
, afStaffDescription = allocationStaffDescription
|
||||
, afStaffRegisterFrom = allocationStaffRegisterFrom
|
||||
, afStaffRegisterTo = allocationStaffRegisterTo
|
||||
, afRegisterFrom = allocationRegisterFrom
|
||||
, afRegisterTo = allocationRegisterTo
|
||||
, afStaffAllocationFrom = allocationStaffAllocationFrom
|
||||
, afStaffAllocationTo = allocationStaffAllocationTo
|
||||
, afRegisterByStaffFrom = allocationRegisterByStaffFrom
|
||||
, afRegisterByStaffTo = allocationRegisterByStaffTo
|
||||
, afRegisterByCourse = allocationRegisterByCourse
|
||||
, afOverrideDeregister = allocationOverrideDeregister
|
||||
}
|
||||
|
||||
((formRes, formView), formEnc) <- runFormPost . renderAForm FormStandard . allocationForm $ Just template
|
||||
|
||||
mAct <- formResultMaybe formRes $ \AllocationForm{..} -> runMaybeT $ do
|
||||
didUpdate <- fmap (is _Nothing) . lift $ replaceUnique aId alloc
|
||||
{ allocationTerm = afTerm
|
||||
, allocationSchool = afSchool
|
||||
, allocationShorthand = afShorthand
|
||||
, allocationName = afName
|
||||
, allocationLegacyShorthands = Set.toList afLegacyShorthands
|
||||
, allocationDescription = afDescription
|
||||
, allocationStaffDescription = afStaffDescription
|
||||
, allocationStaffRegisterFrom = afStaffRegisterFrom
|
||||
, allocationStaffRegisterTo = afStaffRegisterTo
|
||||
, allocationStaffAllocationFrom = afStaffAllocationFrom
|
||||
, allocationStaffAllocationTo = afStaffAllocationTo
|
||||
, allocationRegisterFrom = afRegisterFrom
|
||||
, allocationRegisterTo = afRegisterTo
|
||||
, allocationRegisterByStaffFrom = afRegisterByStaffFrom
|
||||
, allocationRegisterByStaffTo = afRegisterByStaffTo
|
||||
, allocationRegisterByCourse = afRegisterByCourse
|
||||
, allocationOverrideDeregister = afOverrideDeregister
|
||||
}
|
||||
|
||||
unless didUpdate $ do
|
||||
addMessageI Error MsgAllocationEditAlreadyExists
|
||||
mzero
|
||||
|
||||
return $ do
|
||||
addMessageI Success MsgAllocationEditSuccess
|
||||
redirect $ AllocationR afTerm afSchool afShorthand AShowR
|
||||
|
||||
return (alloc, (mAct, (formView, formEnc)))
|
||||
|
||||
sequence_ mAct
|
||||
|
||||
siteLayoutMsg (MsgHeadingAllocationEdit allocationTerm allocationSchool allocationName) $ do
|
||||
setTitleI $ MsgTitleAllocationEdit allocationTerm allocationSchool allocationShorthand
|
||||
|
||||
wrapForm formView def
|
||||
{ formAction = Just . SomeRoute $ AllocationR tid ssh ash AEditR
|
||||
, formEncoding = formEnc
|
||||
}
|
||||
@ -1,244 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Handler.Allocation.EditUser
|
||||
( getAEditUserR, postAEditUserR
|
||||
, getADelUserR, postADelUserR
|
||||
) where
|
||||
|
||||
import Import
|
||||
import Handler.Allocation.Application
|
||||
import Handler.Allocation.UserForm
|
||||
|
||||
import Handler.Utils
|
||||
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import qualified Data.Conduit.Combinators as C
|
||||
|
||||
import Handler.Utils.Delete
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import Handler.Course.Register (deregisterParticipant)
|
||||
|
||||
import Jobs.Queue
|
||||
|
||||
|
||||
data AllocationCourseParticipantFormDefaultReason = AllocationCourseParticipantFormDefaultReason
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
deriving anyclass (Universe, Finite)
|
||||
|
||||
embedRenderMessage ''UniWorX ''AllocationCourseParticipantFormDefaultReason id
|
||||
|
||||
|
||||
getAEditUserR, postAEditUserR :: TermId -> SchoolId -> AllocationShorthand -> CryptoUUIDUser -> Handler Html
|
||||
getAEditUserR = postAEditUserR
|
||||
postAEditUserR tid ssh ash cID = do
|
||||
(Entity _ Allocation{..}, User{..}, editUserAct, editUserForm, regFormForm, formEnctype) <- runDBJobs $ do
|
||||
uid <- decrypt cID
|
||||
user <- get404 uid
|
||||
alloc@(Entity aId _) <- getBy404 $ TermSchoolAllocationShort tid ssh ash
|
||||
Entity auId oldAllocationUser@AllocationUser{..} <- getBy404 $ UniqueAllocationUser aId uid
|
||||
|
||||
regState <- do
|
||||
courses <- E.select . E.from $ \((course `E.InnerJoin` allocationCourse) `E.LeftOuterJoin` courseParticipant `E.LeftOuterJoin` allocationDeregister) -> do
|
||||
E.on $ allocationDeregister E.?. AllocationDeregisterUser E.==. E.justVal uid
|
||||
E.&&. E.joinV (allocationDeregister E.?. AllocationDeregisterCourse) E.==. E.just (allocationCourse E.^. AllocationCourseCourse)
|
||||
E.on $ courseParticipant E.?. CourseParticipantUser E.==. E.justVal uid
|
||||
E.&&. courseParticipant E.?. CourseParticipantCourse E.==. E.just (allocationCourse E.^. AllocationCourseCourse)
|
||||
E.on $ course E.^. CourseId E.==. allocationCourse E.^. AllocationCourseCourse
|
||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
|
||||
return ( course E.^. CourseId
|
||||
, ( ( course E.^. CourseTerm
|
||||
, course E.^. CourseSchool
|
||||
, course E.^. CourseShorthand
|
||||
)
|
||||
, course E.^. CourseName
|
||||
, ( ( E.joinV (courseParticipant E.?. CourseParticipantAllocated) E.==. E.justVal aId
|
||||
E.||. E.isNothing (courseParticipant E.?. CourseParticipantId)
|
||||
, courseParticipant E.?. CourseParticipantState
|
||||
)
|
||||
, ( E.isJust $ allocationDeregister E.?. AllocationDeregisterId
|
||||
, E.joinV $ allocationDeregister E.?. AllocationDeregisterReason
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
return $
|
||||
let toRegState (E.Value cId, (ident, E.Value cname, regState'))
|
||||
= (cId, ((tid', ssh', csh), cname, courseRegState))
|
||||
where (E.Value tid', E.Value ssh', E.Value csh) = ident
|
||||
((E.Value isAlloc, E.Value mParState), (E.Value isDeregister, E.Value regReason)) = regState'
|
||||
courseRegState
|
||||
| not isAlloc = CourseParticipantFormNotAllocated
|
||||
| isDeregister = CourseParticipantFormDeregistered
|
||||
{ cpfDeregisterReason = Just $ fromMaybe defReason regReason
|
||||
, cpfEverRegistered = True
|
||||
}
|
||||
| mParState == Just CourseParticipantActive = CourseParticipantFormRegistered
|
||||
| otherwise = CourseParticipantFormDeregistered
|
||||
{ cpfDeregisterReason = Nothing
|
||||
, cpfEverRegistered = is _Just mParState
|
||||
}
|
||||
defReason = [st|<#{mr AllocationCourseParticipantFormDefaultReason}>|]
|
||||
in Map.fromList $ map toRegState courses
|
||||
|
||||
((formRes, (regFormForm, editUserForm)), formEnctype) <- runFormPost $ \csrf
|
||||
-> let allocForm = renderAForm FormStandard $
|
||||
allocationUserForm aId $ Just AllocationUserForm
|
||||
{ aauUser = uid
|
||||
, aauTotalCourses = allocationUserTotalCourses
|
||||
, aauPriority = allocationUserPriority
|
||||
, aauApplications = Map.empty -- form collects existing applications itself
|
||||
}
|
||||
in (\(regRes, regForm) (editUserRes, editUserForm) -> ((,) <$> regRes <*> editUserRes, (regForm, editUserForm))) <$> courseParticipantForm regState csrf <*> allocForm mempty
|
||||
|
||||
editUserAct <- formResultMaybe formRes $ \(regState', AllocationUserForm{..}) -> Just <$> do
|
||||
now <- liftIO getCurrentTime
|
||||
|
||||
iforM_ (Map.intersectionWith (,) regState' regState) $ \cId (cpf, (_, _, oldCPF)) -> when (cpf /= oldCPF) $ case cpf of
|
||||
CourseParticipantFormNotAllocated -> return ()
|
||||
CourseParticipantFormDeregistered mReason _ -> do
|
||||
hoist liftHandler $ deregisterParticipant uid =<< getJustEntity cId
|
||||
|
||||
app <- getYesod
|
||||
let mReason' = mReason <&> \str -> maybe (Just str) (const Nothing) (listToMaybe $ unRenderMessageLenient @AllocationCourseParticipantFormDefaultReason app str)
|
||||
deleteWhere [AllocationDeregisterUser ==. uid, AllocationDeregisterCourse ==. Just cId]
|
||||
for_ mReason' $ \allocationDeregisterReason ->
|
||||
insert AllocationDeregister
|
||||
{ allocationDeregisterCourse = Just cId
|
||||
, allocationDeregisterTime = now
|
||||
, allocationDeregisterUser = uid
|
||||
, allocationDeregisterReason
|
||||
}
|
||||
CourseParticipantFormRegistered -> do
|
||||
void $ upsert CourseParticipant
|
||||
{ courseParticipantCourse = cId
|
||||
, courseParticipantUser = uid
|
||||
, courseParticipantAllocated = Just aId
|
||||
, courseParticipantState = CourseParticipantActive
|
||||
, courseParticipantRegistration = now
|
||||
}
|
||||
[ CourseParticipantRegistration =. now
|
||||
, CourseParticipantAllocated =. Just aId
|
||||
, CourseParticipantState =. CourseParticipantActive
|
||||
]
|
||||
audit $ TransactionCourseParticipantEdit cId uid
|
||||
queueDBJob . JobQueueNotification $ NotificationCourseRegistered uid cId
|
||||
|
||||
let newAllocationUser = AllocationUser
|
||||
{ allocationUserAllocation = aId
|
||||
, allocationUserUser = aauUser
|
||||
, allocationUserTotalCourses = aauTotalCourses
|
||||
, allocationUserPriority = aauPriority
|
||||
}
|
||||
when (newAllocationUser /= oldAllocationUser) $ do
|
||||
replace auId newAllocationUser
|
||||
audit $ TransactionAllocationUserEdited aauUser aId
|
||||
|
||||
-- Applications are complicated and it isn't easy to detect if something changed
|
||||
-- Therefore we just always replace...
|
||||
oldApps <- selectList [CourseApplicationUser ==. aauUser, CourseApplicationAllocation ==. Just aId] []
|
||||
forM_ oldApps $ \(Entity appId CourseApplication{..}) -> do
|
||||
deleteWhere [ CourseApplicationFileApplication ==. appId ]
|
||||
delete appId
|
||||
unless (courseApplicationCourse `Map.member` aauApplications) $
|
||||
audit $ TransactionCourseApplicationDeleted courseApplicationCourse courseApplicationUser appId
|
||||
|
||||
iforM_ aauApplications $ \cId ApplicationForm{..} -> maybeT_ $ do
|
||||
prio <- hoistMaybe afPriority
|
||||
let rated = afRatingVeto || is _Just afRatingPoints
|
||||
appId <- lift $ insert CourseApplication
|
||||
{ courseApplicationCourse = cId
|
||||
, courseApplicationUser = aauUser
|
||||
, courseApplicationText = afText
|
||||
, courseApplicationRatingVeto = afRatingVeto
|
||||
, courseApplicationRatingPoints = afRatingPoints
|
||||
, courseApplicationRatingComment = afRatingComment
|
||||
, courseApplicationAllocation = Just aId
|
||||
, courseApplicationAllocationPriority = Just prio
|
||||
, courseApplicationTime = now
|
||||
, courseApplicationRatingTime = guardOn rated now
|
||||
}
|
||||
lift . runConduit $ transPipe liftHandler (sequence_ afFiles) .| C.mapM_ (insert_ . review _FileReference . (, CourseApplicationFileResidual appId))
|
||||
lift . audit $ TransactionCourseApplicationEdit cId aauUser appId
|
||||
|
||||
return $ do
|
||||
addMessageI Success MsgAllocationEditUserUserEdited
|
||||
redirect . AllocationR tid ssh ash $ AEditUserR cID
|
||||
|
||||
return (alloc, user, editUserAct, editUserForm, regFormForm, formEnctype)
|
||||
|
||||
sequence_ editUserAct
|
||||
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
let title = MsgAllocationEditUserTitle (mr . ShortTermIdentifier $ unTermKey allocationTerm) (unSchoolKey allocationSchool) allocationShorthand userDisplayName
|
||||
shortTitle = MsgAllocationEditUserShortTitle allocationTerm allocationSchool allocationShorthand userDisplayName
|
||||
|
||||
siteLayoutMsg title $ do
|
||||
setTitleI shortTitle
|
||||
wrapForm $(widgetFile "allocation/edit-user") FormSettings
|
||||
{ formMethod = POST
|
||||
, formAction = Just . SomeRoute . AllocationR tid ssh ash $ AEditUserR cID
|
||||
, formEncoding = formEnctype
|
||||
, formAttrs = []
|
||||
, formSubmit = FormSubmit
|
||||
, formAnchor = Nothing :: Maybe Text
|
||||
}
|
||||
|
||||
getADelUserR, postADelUserR :: TermId -> SchoolId -> AllocationShorthand -> CryptoUUIDUser -> Handler Html
|
||||
getADelUserR = postADelUserR
|
||||
postADelUserR tid ssh ash cID = do
|
||||
uid <- decrypt cID
|
||||
(aId, auId) <- runDB . maybeT notFound $ do
|
||||
aId <- MaybeT . getKeyBy $ TermSchoolAllocationShort tid ssh ash
|
||||
auId <- MaybeT . getKeyBy $ UniqueAllocationUser aId uid
|
||||
return (aId, auId)
|
||||
|
||||
deleteR DeleteRoute
|
||||
{ drRecords = Set.singleton auId
|
||||
, drGetInfo = \(allocationUser `E.InnerJoin` user) -> do
|
||||
E.on $ allocationUser E.^. AllocationUserUser E.==. user E.^. UserId
|
||||
|
||||
let appsCount = E.subSelectCount . E.from $ \courseApplication ->
|
||||
E.where_ $ courseApplication E.^. CourseApplicationUser E.==. allocationUser E.^. AllocationUserUser
|
||||
E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocationUser E.^. AllocationUserAllocation)
|
||||
allocsCount = E.subSelectCount . E.from $ \courseParticipant ->
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. allocationUser E.^. AllocationUserUser
|
||||
E.&&. courseParticipant E.^. CourseParticipantAllocated E.==. E.just (allocationUser E.^. AllocationUserAllocation)
|
||||
|
||||
return ( ( user E.^. UserDisplayName, user E.^. UserSurname )
|
||||
, appsCount :: E.SqlExpr (E.Value Word64)
|
||||
, allocsCount :: E.SqlExpr (E.Value Word64)
|
||||
)
|
||||
, drUnjoin = \(allocationUser `E.InnerJoin` _user) -> allocationUser
|
||||
, drRenderRecord = \((E.Value dName, E.Value sName), E.Value (assertM' (> 0) -> appsCount), E.Value (assertM' (> 0) -> allocsCount)) -> return
|
||||
[whamlet|
|
||||
$newline never
|
||||
^{nameWidget dName sName}
|
||||
$if is _Just appsCount || is _Just allocsCount
|
||||
\ (
|
||||
$maybe c <- appsCount
|
||||
_{MsgAllocationApplicationsCount c}
|
||||
$if is _Just appsCount || is _Just allocsCount
|
||||
, #
|
||||
$maybe c <- appsCount
|
||||
_{MsgAllocationAllocationsCount c}
|
||||
)
|
||||
|]
|
||||
, drRecordConfirmString = \((E.Value dName, _), _, _) -> return [st|#{dName}|]
|
||||
, drFormMessage = \_ -> return Nothing
|
||||
, drCaption = SomeMessage MsgAllocationUserDeleteQuestion
|
||||
, drSuccessMessage = SomeMessage MsgAllocationUserDeleted
|
||||
, drAbort = SomeRoute . AllocationR tid ssh ash $ AEditUserR cID
|
||||
, drSuccess = SomeRoute $ AllocationR tid ssh ash AUsersR
|
||||
, drDelete = \_k doDelete -> do
|
||||
res <- doDelete
|
||||
audit $ TransactionAllocationUserDeleted uid aId
|
||||
return res
|
||||
}
|
||||
@ -1,186 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Handler.Allocation.Form
|
||||
( AllocationForm(..)
|
||||
, allocationForm
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import qualified Control.Monad.State.Class as State
|
||||
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.Text as Text
|
||||
|
||||
|
||||
data AllocationForm = AllocationForm
|
||||
{ afTerm :: TermId
|
||||
, afSchool :: SchoolId
|
||||
, afShorthand :: AllocationShorthand
|
||||
, afName :: AllocationName
|
||||
, afLegacyShorthands :: Set AllocationShorthand
|
||||
, afDescription, afStaffDescription :: Maybe StoredMarkup
|
||||
, afStaffRegisterFrom, afStaffRegisterTo
|
||||
, afRegisterFrom, afRegisterTo
|
||||
, afStaffAllocationFrom, afStaffAllocationTo
|
||||
, afRegisterByStaffFrom, afRegisterByStaffTo
|
||||
, afRegisterByCourse, afOverrideDeregister :: Maybe UTCTime
|
||||
} deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
|
||||
|
||||
allocationForm :: Maybe AllocationForm
|
||||
-> AForm (YesodDB UniWorX) AllocationForm
|
||||
allocationForm mTemplate = validateAForm validateAllocationForm . wFormToAForm $ do
|
||||
mayEditTerms <- lift . lift $ hasWriteAccessTo TermEditR
|
||||
now <- liftIO getCurrentTime
|
||||
muid <- maybeAuthId
|
||||
termOptions <-
|
||||
let termQuery :: E.SqlQuery (E.SqlExpr (E.Value TermId))
|
||||
termQuery = E.from $ \t -> do
|
||||
unless mayEditTerms $
|
||||
E.where_ $ E.just (t E.^. TermId) E.==. E.val (afTerm <$> mTemplate)
|
||||
E.||. termIsActiveE (E.val now) (E.val muid) (t E.^. TermId)
|
||||
E.orderBy [E.desc $ t E.^. TermStart]
|
||||
return $ t E.^. TermId
|
||||
in lift . lift $ mkOptionsE
|
||||
termQuery
|
||||
(return . toPathPiece . E.unValue)
|
||||
(return . ShortTermIdentifier . unTermKey . E.unValue)
|
||||
(return . E.unValue)
|
||||
|
||||
schoolOptions <-
|
||||
let schoolQuery :: E.SqlQuery (E.SqlExpr (Entity School))
|
||||
schoolQuery = E.from $ \s -> do
|
||||
E.where_ $ E.exists (E.from $ \userFunction -> do
|
||||
E.where_ $ userFunction E.^. UserFunctionSchool E.==. s E.^. SchoolId
|
||||
E.&&. E.just (userFunction E.^. UserFunctionUser) E.==. E.val muid
|
||||
E.&&. userFunction E.^. UserFunctionFunction `E.in_` E.valList [SchoolAdmin, SchoolAllocation]
|
||||
)
|
||||
E.||. E.just (s E.^. SchoolId) E.==. E.val (afSchool <$> mTemplate)
|
||||
E.orderBy [E.asc $ s E.^. SchoolShorthand]
|
||||
return s
|
||||
in lift . lift $ mkOptionsE
|
||||
schoolQuery
|
||||
(return . toPathPiece . entityKey)
|
||||
(return . schoolName . entityVal)
|
||||
(return . entityKey)
|
||||
|
||||
template <- maybe (lift . lift $ suggestAllocationForm termOptions schoolOptions) (return . Just) mTemplate
|
||||
|
||||
let cfCommaSeparatedSet :: forall m. Functor m => Field m Text -> Field m (Set (CI Text))
|
||||
cfCommaSeparatedSet = guardField (not . Set.null) . convertField (Set.fromList . mapMaybe (fmap CI.mk . assertM' (not . Text.null) . Text.strip) . Text.splitOn ",") (Text.intercalate ", " . map CI.original . Set.toList)
|
||||
|
||||
aFormToWForm . hoistAForm liftHandler $ AllocationForm
|
||||
<$> areq (selectField $ return termOptions) (fslI MsgAllocationFormTerm) (afTerm <$> template)
|
||||
<*> areq (selectField $ return schoolOptions) (fslI MsgAllocationFormSchool) (afSchool <$> template)
|
||||
<*> areq (textField & cfStrip & cfCI) (fslI MsgAllocationFormShorthand) (afShorthand <$> template)
|
||||
<*> areq (textField & cfStrip & cfCI) (fslI MsgAllocationFormName) (afName <$> template)
|
||||
<*> (fromMaybe Set.empty <$> aopt (textField & cfCommaSeparatedSet) (fslI MsgAllocationFormLegacyShorthands & setTooltip MsgAllocationFormLegacyShorthandsTip) (fmap Just $ afLegacyShorthands <$> template))
|
||||
<* aformSection MsgAllocationFormDescriptions
|
||||
<*> aopt htmlField (fslI MsgAllocationFormDescription & setTooltip MsgAllocationFormDescriptionTip) (afDescription <$> template)
|
||||
<*> aopt htmlField (fslI MsgAllocationFormStaffDescription & setTooltip MsgAllocationFormStaffDescriptionTip) (afStaffDescription <$> template)
|
||||
<* aformSection MsgAllocationFormDeadlines
|
||||
<*> aopt utcTimeField (fslI MsgAllocationFormStaffRegisterFrom & setTooltip MsgAllocationFormStaffRegisterFromTip) (afStaffRegisterFrom <$> template)
|
||||
<*> aopt utcTimeField (fslI MsgAllocationFormStaffRegisterTo & setTooltip MsgAllocationFormStaffRegisterToTip) (afStaffRegisterTo <$> template)
|
||||
<*> aopt utcTimeField (fslI MsgAllocationFormRegisterFrom & setTooltip MsgAllocationFormRegisterFromTip) (afRegisterFrom <$> template)
|
||||
<*> aopt utcTimeField (fslI MsgAllocationFormRegisterTo & setTooltip MsgAllocationFormRegisterToTip) (afRegisterTo <$> template)
|
||||
<*> aopt utcTimeField (fslI MsgAllocationFormStaffAllocationFrom & setTooltip MsgAllocationFormStaffAllocationFromTip) (afStaffAllocationFrom <$> template)
|
||||
<*> aopt utcTimeField (fslI MsgAllocationFormStaffAllocationTo & setTooltip MsgAllocationFormStaffAllocationToTip) (afStaffAllocationTo <$> template)
|
||||
<*> aopt utcTimeField (fslI MsgAllocationFormRegisterByStaffFrom & setTooltip MsgAllocationFormRegisterByStaffFromTip) (afRegisterByStaffFrom <$> template)
|
||||
<*> aopt utcTimeField (fslI MsgAllocationFormRegisterByStaffTo & setTooltip MsgAllocationFormRegisterByStaffToTip) (afRegisterByStaffTo <$> template)
|
||||
<*> aopt utcTimeField (fslI MsgAllocationFormRegisterByCourse & setTooltip MsgAllocationFormRegisterByCourseTip) (afRegisterByCourse <$> template)
|
||||
<*> aopt utcTimeField (fslI MsgAllocationFormOverrideDeregister & setTooltip MsgAllocationFormOverrideDeregisterTip) (afOverrideDeregister <$> template)
|
||||
|
||||
validateAllocationForm :: FormValidator AllocationForm (YesodDB UniWorX) ()
|
||||
validateAllocationForm = do
|
||||
State.modify $ \af -> af { afLegacyShorthands = Set.delete (afShorthand af) $ afLegacyShorthands af }
|
||||
|
||||
AllocationForm{..} <- State.get
|
||||
|
||||
guardValidation MsgAllocationFormStaffRegisterToMustBeAfterFrom
|
||||
$ NTop afStaffRegisterFrom <= NTop afStaffRegisterTo
|
||||
guardValidation MsgAllocationFormStaffAllocationToMustBeAfterFrom
|
||||
$ NTop afStaffAllocationFrom <= NTop afStaffAllocationTo
|
||||
guardValidation MsgAllocationFormRegisterToMustBeAfterFrom
|
||||
$ NTop afRegisterFrom <= NTop afRegisterTo
|
||||
guardValidation MsgAllocationFormRegisterByStaffToMustBeAfterFrom
|
||||
$ NTop afRegisterByStaffFrom <= NTop afRegisterByStaffTo
|
||||
|
||||
guardValidation MsgAllocationFormStaffRegisterFromMustBeBeforeStaffAllocationFrom
|
||||
$ NTop afStaffRegisterFrom <= NTop afStaffAllocationFrom
|
||||
guardValidation MsgAllocationFormStaffRegisterToMustBeBeforeStaffAllocationTo
|
||||
$ NTop afStaffRegisterTo <= NTop afStaffAllocationTo
|
||||
|
||||
guardValidation MsgAllocationFormStaffRegisterFromMustBeBeforeRegisterFrom
|
||||
$ NTop afStaffRegisterFrom <= NTop afRegisterFrom
|
||||
guardValidation MsgAllocationFormStaffRegisterToMustBeBeforeRegisterTo
|
||||
$ NTop afStaffRegisterTo <= NTop afRegisterTo
|
||||
|
||||
warnValidation MsgAllocationFormStaffAllocationToShouldBeBeforeRegisterByStaffFrom
|
||||
$ NTop afStaffAllocationTo <= NTop afRegisterByStaffFrom
|
||||
warnValidation MsgAllocationFormStaffAllocationToShouldBeBeforeRegisterByCourse
|
||||
$ NTop afStaffAllocationTo <= NTop afRegisterByCourse
|
||||
warnValidation MsgAllocationFormStaffAllocationToShouldBeAfterRegisterTo
|
||||
$ NTop afStaffAllocationTo >= NTop afRegisterTo
|
||||
|
||||
warnValidation MsgAllocationFormRegisterToShouldBeBeforeRegisterByStaffFrom
|
||||
$ NTop afRegisterTo <= NTop afRegisterByStaffFrom
|
||||
warnValidation MsgAllocationFormRegisterToShouldBeBeforeRegisterByCourse
|
||||
$ NTop afRegisterTo <= NTop afRegisterByCourse
|
||||
|
||||
warnValidation MsgAllocationFormRegisterByStaffFromShouldBeBeforeRegisterByCourse
|
||||
$ NTop afRegisterByStaffFrom <= NTop afRegisterByCourse
|
||||
|
||||
suggestAllocationForm :: OptionList TermId -> OptionList SchoolId
|
||||
-> DB (Maybe AllocationForm)
|
||||
suggestAllocationForm (Set.fromList . map optionInternalValue . olOptions -> terms) (Set.fromList . map optionInternalValue . olOptions -> schools) = runMaybeT $ do
|
||||
allocs <- lift . E.select . E.from $ \alloc -> do
|
||||
E.where_ $ alloc E.^. AllocationSchool `E.in_` E.valList (Set.toList schools)
|
||||
return ( alloc E.^. AllocationTerm
|
||||
, alloc E.^. AllocationSchool
|
||||
, alloc E.^. AllocationShorthand
|
||||
)
|
||||
let allocTerms = Map.fromListWith (<>) $ do
|
||||
(E.Value tid, E.Value ssh, E.Value ash) <- allocs
|
||||
return ((ssh, ash), Set.singleton tid)
|
||||
nextAlloc = flip Map.mapMaybe allocTerms $ \(Set.toDescList -> tids) -> case tids of
|
||||
TermKey t1 : TermKey t2 : _ -> Just . TermKey . toEnum $ fromEnum t1 + (fromEnum t1 - fromEnum t2)
|
||||
TermKey t1 : _ -> Just . TermKey $ succ t1
|
||||
_other -> Nothing
|
||||
maxAllocTerm <- hoistMaybe . fmap maximum . fromNullable $ Map.mapMaybe Set.lookupMax allocTerms
|
||||
((ssh, ash), tid) <- hoistMaybe . fmap (minimumBy $ comparing (view _2) <> comparing (view _1)) . fromNullable . Map.toList $ Map.filter (\t -> t >= maxAllocTerm && t `Set.member` terms) nextAlloc
|
||||
oldTid <- hoistMaybe $ Set.lookupMax =<< Map.lookup (ssh, ash) allocTerms
|
||||
oldTerm <- MaybeT $ get oldTid
|
||||
newTerm <- MaybeT $ get tid
|
||||
Entity _ Allocation{..} <- MaybeT . getBy $ TermSchoolAllocationShort oldTid ssh ash
|
||||
|
||||
let addTime = addLocalDays $ (diffDays `on` termLectureStart) newTerm oldTerm
|
||||
|
||||
return AllocationForm
|
||||
{ afTerm = tid
|
||||
, afSchool = ssh
|
||||
, afShorthand = ash
|
||||
, afName = allocationName
|
||||
, afLegacyShorthands = Set.delete ash $ Set.fromList allocationLegacyShorthands
|
||||
, afDescription = allocationDescription
|
||||
, afStaffDescription = allocationStaffDescription
|
||||
, afStaffRegisterFrom = addTime <$> allocationStaffRegisterFrom
|
||||
, afStaffRegisterTo = addTime <$> allocationStaffRegisterTo
|
||||
, afStaffAllocationFrom = addTime <$> allocationStaffAllocationFrom
|
||||
, afStaffAllocationTo = addTime <$> allocationStaffAllocationTo
|
||||
, afRegisterFrom = addTime <$> allocationRegisterFrom
|
||||
, afRegisterTo = addTime <$> allocationRegisterTo
|
||||
, afRegisterByStaffFrom = addTime <$> allocationRegisterByStaffFrom
|
||||
, afRegisterByStaffTo = addTime <$> allocationRegisterByStaffTo
|
||||
, afRegisterByCourse = addTime <$> allocationRegisterByCourse
|
||||
, afOverrideDeregister = addTime <$> allocationOverrideDeregister
|
||||
}
|
||||
@ -1,20 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Handler.Allocation.Info
|
||||
( getInfoAllocationR
|
||||
) where
|
||||
|
||||
import Import
|
||||
import Handler.Utils
|
||||
|
||||
import Handler.Info (FAQItem(..))
|
||||
|
||||
|
||||
getInfoAllocationR :: Handler Html
|
||||
getInfoAllocationR =
|
||||
siteLayoutMsg MsgHeadingAllocationInfo $ do
|
||||
setTitleI MsgHeadingAllocationInfo
|
||||
faqItemUrlAllocationNoPlaces <- toTextUrl $ FaqR :#: FAQAllocationNoPlaces
|
||||
$(i18nWidgetFile "allocation-info")
|
||||
@ -1,149 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
|
||||
|
||||
module Handler.Allocation.List
|
||||
( getAllocationListR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Course (mayViewCourse)
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
import Handler.Utils.Table.Columns
|
||||
import Handler.Utils.Table.Pagination
|
||||
|
||||
|
||||
type AllocationTableExpr = E.SqlExpr (Entity Allocation)
|
||||
type AllocationTableData = DBRow (Entity Allocation, Natural, Natural)
|
||||
|
||||
allocationListIdent :: Text
|
||||
allocationListIdent = "allocations"
|
||||
|
||||
queryAllocation :: Getter AllocationTableExpr (E.SqlExpr (Entity Allocation))
|
||||
queryAllocation = id
|
||||
|
||||
|
||||
countCourses :: (Num n, PersistField n)
|
||||
=> Maybe UserId -> AuthTagActive -> UTCTime
|
||||
-> (E.SqlExpr (Entity AllocationCourse) -> E.SqlExpr (E.Value Bool))
|
||||
-> E.SqlExpr (Entity Allocation)
|
||||
-> E.SqlExpr (E.Value n)
|
||||
countCourses muid ata now addWhere allocation = E.subSelectCount . E.from $ \allocationCourse ->
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseAllocation E.==. allocation E.^. AllocationId
|
||||
E.&&. E.exists (E.from $ \course -> E.where_ $
|
||||
course E.^. CourseId E.==. allocationCourse E.^. AllocationCourseCourse
|
||||
E.&&. mayViewCourse muid ata now course (E.just $ allocation E.^. AllocationId)
|
||||
) E.&&. addWhere allocationCourse
|
||||
|
||||
queryAvailable :: Maybe UserId -> AuthTagActive -> UTCTime
|
||||
-> Getter AllocationTableExpr (E.SqlExpr (E.Value Word64))
|
||||
queryAvailable muid ata now = queryAllocation . to (countCourses muid ata now $ const E.true)
|
||||
|
||||
queryApplied :: AuthTagActive -> UTCTime -> UserId -> Getter AllocationTableExpr (E.SqlExpr (E.Value Word64))
|
||||
queryApplied ata now uid = queryAllocation . to (\allocation -> countCourses (Just uid) ata now (addWhere allocation) allocation)
|
||||
where
|
||||
addWhere allocation allocationCourse
|
||||
= E.exists . E.from $ \courseApplication ->
|
||||
E.where_ $ courseApplication E.^. CourseApplicationCourse E.==. allocationCourse E.^. AllocationCourseCourse
|
||||
E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocation E.^. AllocationId)
|
||||
E.&&. courseApplication E.^. CourseApplicationUser E.==. E.val uid
|
||||
|
||||
resultAllocation :: Lens' AllocationTableData (Entity Allocation)
|
||||
resultAllocation = _dbrOutput . _1
|
||||
|
||||
resultAvailable, resultApplied :: Lens' AllocationTableData Natural
|
||||
resultAvailable = _dbrOutput . _2
|
||||
resultApplied = _dbrOutput . _3
|
||||
|
||||
allocationTermLink :: TermId -> SomeRoute UniWorX
|
||||
allocationTermLink tid = SomeRoute (AllocationListR, [(dbFilterKey allocationListIdent "term", toPathPiece tid)])
|
||||
|
||||
allocationSchoolLink :: SchoolId -> SomeRoute UniWorX
|
||||
allocationSchoolLink ssh = SomeRoute (AllocationListR, [(dbFilterKey allocationListIdent "school", toPathPiece ssh)])
|
||||
|
||||
allocationLink :: Allocation -> SomeRoute UniWorX
|
||||
allocationLink Allocation{..} = SomeRoute $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR
|
||||
|
||||
getAllocationListR :: Handler Html
|
||||
getAllocationListR = do
|
||||
muid <- maybeAuthId
|
||||
ata <- getSessionActiveAuthTags
|
||||
now <- liftIO getCurrentTime
|
||||
let
|
||||
dbtSQLQuery :: AllocationTableExpr -> E.SqlQuery _
|
||||
dbtSQLQuery = runReaderT $ (,,)
|
||||
<$> view queryAllocation
|
||||
<*> view (queryAvailable muid ata now)
|
||||
<*> view (maybe (to . const $ E.val 0) (queryApplied ata now) muid)
|
||||
|
||||
dbtProj :: _ AllocationTableData
|
||||
dbtProj = dbtProjId
|
||||
<&> _dbrOutput . _2 %~ fromIntegral . E.unValue
|
||||
<&> _dbrOutput . _3 %~ fromIntegral . E.unValue
|
||||
|
||||
dbtRowKey = view $ queryAllocation . to (E.^. AllocationId)
|
||||
|
||||
dbtColonnade :: Colonnade Sortable _ _
|
||||
dbtColonnade = mconcat
|
||||
[ anchorColonnade (views (resultAllocation . _entityVal . _allocationTerm) allocationTermLink) $ colTermShort (resultAllocation . _entityVal . _allocationTerm)
|
||||
, anchorColonnade (views (resultAllocation . _entityVal . _allocationSchool) allocationSchoolLink) $ colSchoolShort (resultAllocation . _entityVal . _allocationSchool)
|
||||
, anchorColonnade (views (resultAllocation . _entityVal) allocationLink) $ colAllocationName (resultAllocation . _entityVal . _allocationName)
|
||||
, sortable (Just "available") (i18nCell MsgAllocationAvailableCourses) $ views resultAvailable i18nCell
|
||||
, if
|
||||
| Just _ <- muid
|
||||
-> sortable (Just "applied") (i18nCell MsgAllocationAppliedCourses) . views resultApplied $ maybe mempty i18nCell . assertM' (> 0)
|
||||
| otherwise
|
||||
-> mempty
|
||||
]
|
||||
|
||||
dbtSorting = mconcat
|
||||
[ sortTerm $ queryAllocation . to (E.^. AllocationTerm)
|
||||
, sortSchoolShort $ queryAllocation . to (E.^. AllocationSchool)
|
||||
, sortAllocationName $ queryAllocation . to (E.^. AllocationName)
|
||||
, singletonMap "available" . SortColumn $ view (queryAvailable muid ata now)
|
||||
, if
|
||||
| Just uid <- muid
|
||||
-> singletonMap "applied" . SortColumn . view $ queryApplied ata now uid
|
||||
| otherwise
|
||||
-> mempty
|
||||
]
|
||||
|
||||
dbtFilter = mconcat
|
||||
[ fltrAllocationActive now queryAllocation
|
||||
, fltrTerm $ queryAllocation . to (E.^. AllocationTerm)
|
||||
, fltrSchool $ queryAllocation . to (E.^. AllocationSchool)
|
||||
, fltrAllocation queryAllocation
|
||||
]
|
||||
dbtFilterUI = mconcat
|
||||
[ fltrAllocationActiveUI
|
||||
, fltrTermUI
|
||||
, fltrSchoolUI
|
||||
, fltrAllocationUI
|
||||
]
|
||||
|
||||
dbtStyle = def
|
||||
{ dbsFilterLayout = defaultDBSFilterLayout
|
||||
}
|
||||
dbtParams = def
|
||||
|
||||
dbtCsvEncode = noCsvEncode
|
||||
dbtCsvDecode = Nothing
|
||||
|
||||
dbtExtraReps = []
|
||||
|
||||
dbtIdent = allocationListIdent
|
||||
|
||||
psValidator :: PSValidator _ _
|
||||
psValidator = def
|
||||
& defaultSorting [SortDescBy "term", SortAscBy "school-short", SortAscBy "allocation"]
|
||||
|
||||
table <- runDB $ dbTableWidget' psValidator DBTable{..}
|
||||
|
||||
siteLayoutMsg MsgAllocationListTitle $ do
|
||||
setTitleI MsgAllocationListTitle
|
||||
table
|
||||
@ -1,43 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Handler.Allocation.Matchings
|
||||
( getAMatchingListR
|
||||
, getAMLogR
|
||||
) where
|
||||
|
||||
import Import
|
||||
import Handler.Utils
|
||||
|
||||
import Data.ByteString.Base32
|
||||
import qualified Data.ByteArray as BA
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
|
||||
getAMatchingListR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
|
||||
getAMatchingListR tid ssh ash = do
|
||||
(Allocation{..}, matchings) <- runDB $ do
|
||||
Entity aId alloc <- getBy404 $ TermSchoolAllocationShort tid ssh ash
|
||||
matchings <- selectList [ AllocationMatchingAllocation ==. aId ] [ Desc AllocationMatchingTime ]
|
||||
matchings' <- forM matchings $ \(Entity matchingId m) -> (, m) <$> encrypt matchingId
|
||||
return (alloc, matchings')
|
||||
|
||||
siteLayoutMsg (MsgHeadingAllocationMatchings allocationTerm allocationSchool allocationName) $ do
|
||||
setTitleI $ MsgTitleAllocationMatchings allocationTerm allocationSchool allocationShorthand
|
||||
|
||||
$(widgetFile "allocation/matchings")
|
||||
where
|
||||
showFingerprint = CI.foldCase . encodeBase32Unpadded . BA.convert
|
||||
|
||||
getAMLogR :: TermId -> SchoolId -> AllocationShorthand -> CryptoUUIDAllocationMatching -> Handler TypedContent
|
||||
getAMLogR tid ssh ash cID = serveOneFile $ do
|
||||
matchingId <- decrypt @AllocationMatchingId cID
|
||||
AllocationMatching{..} <- lift $ get404 matchingId
|
||||
mr <- getMessageRender
|
||||
let fileReferenceTitle = unpack . mr $ MsgAllocationMatchingLogFileName tid ssh ash cID
|
||||
yield FileReference
|
||||
{ fileReferenceTitle
|
||||
, fileReferenceContent = Just allocationMatchingLog
|
||||
, fileReferenceModified = allocationMatchingTime
|
||||
}
|
||||
@ -1,67 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Handler.Allocation.New
|
||||
( getAllocationNewR, postAllocationNewR
|
||||
) where
|
||||
|
||||
import Import
|
||||
import Handler.Utils
|
||||
|
||||
import Handler.Allocation.Form
|
||||
|
||||
import qualified Crypto.Random as Crypto
|
||||
|
||||
import qualified Data.Set as Set
|
||||
|
||||
|
||||
getAllocationNewR, postAllocationNewR :: Handler Html
|
||||
getAllocationNewR = postAllocationNewR
|
||||
postAllocationNewR = do
|
||||
(mAct, (formView, formEnc)) <- runDB $ do
|
||||
((formRes, formView), formEnc) <- runFormPost . renderAForm FormStandard $ allocationForm Nothing
|
||||
|
||||
mAct <- formResultMaybe formRes $ \AllocationForm{..} -> runMaybeT $ do
|
||||
allocationMatchingSeed <- liftIO $ Crypto.getRandomBytes 32
|
||||
|
||||
insertRes <- lift $ insertUnique Allocation
|
||||
{ allocationTerm = afTerm
|
||||
, allocationSchool = afSchool
|
||||
, allocationShorthand = afShorthand
|
||||
, allocationName = afName
|
||||
, allocationLegacyShorthands = Set.toList afLegacyShorthands
|
||||
, allocationDescription = afDescription
|
||||
, allocationStaffDescription = afStaffDescription
|
||||
, allocationStaffRegisterFrom = afStaffRegisterFrom
|
||||
, allocationStaffRegisterTo = afStaffRegisterTo
|
||||
, allocationStaffAllocationFrom = afStaffAllocationFrom
|
||||
, allocationStaffAllocationTo = afStaffAllocationTo
|
||||
, allocationRegisterFrom = afRegisterFrom
|
||||
, allocationRegisterTo = afRegisterTo
|
||||
, allocationRegisterByStaffFrom = afRegisterByStaffFrom
|
||||
, allocationRegisterByStaffTo = afRegisterByStaffTo
|
||||
, allocationRegisterByCourse = afRegisterByCourse
|
||||
, allocationOverrideDeregister = afOverrideDeregister
|
||||
, allocationMatchingSeed
|
||||
}
|
||||
|
||||
unless (is _Just insertRes) $ do
|
||||
addMessageI Error MsgAllocationNewAlreadyExists
|
||||
mzero
|
||||
|
||||
return $ do
|
||||
addMessageI Success MsgAllocationNewSuccess
|
||||
redirect $ AllocationR afTerm afSchool afShorthand AShowR
|
||||
|
||||
return (mAct, (formView, formEnc))
|
||||
|
||||
sequence_ mAct
|
||||
|
||||
siteLayoutMsg MsgTitleAllocationNew $ do
|
||||
setTitleI MsgTitleAllocationNew
|
||||
|
||||
wrapForm formView def
|
||||
{ formAction = Just $ SomeRoute AllocationNewR
|
||||
, formEncoding = formEnc
|
||||
}
|
||||
@ -1,100 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Handler.Allocation.Prios
|
||||
( getAPriosR, postAPriosR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Csv
|
||||
import Handler.Utils.Allocation
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
import qualified Data.Csv as Csv
|
||||
|
||||
|
||||
data AllocationPrioritiesMode
|
||||
= AllocationPrioritiesNumeric
|
||||
| AllocationPrioritiesOrdinal
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Universe AllocationPrioritiesMode
|
||||
instance Finite AllocationPrioritiesMode
|
||||
|
||||
nullaryPathPiece ''AllocationPrioritiesMode $ camelToPathPiece' 2
|
||||
|
||||
embedRenderMessage ''UniWorX ''AllocationPrioritiesMode id
|
||||
|
||||
|
||||
getAPriosR, postAPriosR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
|
||||
getAPriosR = postAPriosR
|
||||
postAPriosR tid ssh ash = do
|
||||
doNumericPrios <- runDB $ do
|
||||
Entity aId _ <- getBy404 $ TermSchoolAllocationShort tid ssh ash
|
||||
|
||||
numericPrios <- E.selectCountRows . E.from $ \allocationUser -> do
|
||||
E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. E.val aId
|
||||
E.where_ . E.maybe E.false sqlAllocationPriorityNumeric $ allocationUser E.^. AllocationUserPriority
|
||||
|
||||
ordinalPrios <- E.selectCountRows . E.from $ \allocationUser -> do
|
||||
E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. E.val aId
|
||||
E.where_ . E.maybe E.false (E.not_ . sqlAllocationPriorityNumeric) $ allocationUser E.^. AllocationUserPriority
|
||||
let doNumericPrios = ((>=) :: Int64 -> Int64 -> Bool) numericPrios ordinalPrios
|
||||
|
||||
return doNumericPrios
|
||||
|
||||
let explainAllocationPrioMode = \case
|
||||
AllocationPrioritiesNumeric -> return $(i18nWidgetFile "allocation-priority-explanation/numeric")
|
||||
AllocationPrioritiesOrdinal -> return $(i18nWidgetFile "allocation-priority-explanation/ordinal")
|
||||
|
||||
ignoreWarningMsg <- messageIconI Warning IconMissingAllocationPriority MsgAllocationMissingPrioritiesIgnored
|
||||
((priosRes, priosView), priosEnctype) <- runFormPost . renderAForm FormStandard $ (,)
|
||||
<$> apopt (explainedSelectionField Nothing (explainOptionList optionsFinite explainAllocationPrioMode)) (fslI MsgAllocationPrioritiesMode) (Just $ bool AllocationPrioritiesOrdinal AllocationPrioritiesNumeric doNumericPrios)
|
||||
<* aformMessage ignoreWarningMsg
|
||||
<*> areq fileField (fslI MsgAllocationPrioritiesFile) Nothing
|
||||
|
||||
formResult priosRes $ \(mode, fInfo) -> do
|
||||
let sourcePrios = case mode of
|
||||
AllocationPrioritiesNumeric -> transPipe liftHandler fInfo .| fileSourceCsvPositional Csv.NoHeader
|
||||
AllocationPrioritiesOrdinal -> transPipe liftHandler fInfo .| fileSourceCsvPositional Csv.NoHeader .| C.map Csv.fromOnly .| ordinalPriorities
|
||||
|
||||
(matrSunk, matrMissing) <- runDB $ do
|
||||
Entity aId _ <- getBy404 $ TermSchoolAllocationShort tid ssh ash
|
||||
updateWhere
|
||||
[ AllocationUserAllocation ==. aId ]
|
||||
[ AllocationUserPriority =. Nothing ]
|
||||
matrSunk <- runConduit $ sourcePrios .| sinkAllocationPriorities aId
|
||||
matrMissing <- E.selectCountRows . E.from $ \allocationUser -> do
|
||||
E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. E.val aId
|
||||
E.&&. E.isNothing (allocationUser E.^. AllocationUserPriority)
|
||||
|
||||
E.where_ . E.exists . E.from $ \(courseApplication `E.InnerJoin` allocationCourse) -> do
|
||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. courseApplication E.^. CourseApplicationCourse
|
||||
E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
|
||||
E.where_ $ courseApplication E.^. CourseApplicationUser E.==. allocationUser E.^. AllocationUserUser
|
||||
E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (E.val aId)
|
||||
return (matrSunk, matrMissing)
|
||||
|
||||
when (matrSunk > 0) $
|
||||
addMessageI Success $ MsgAllocationPrioritiesSunk matrSunk
|
||||
when (matrMissing > 0) $
|
||||
addMessageI Error $ MsgAllocationPrioritiesMissing matrMissing
|
||||
redirect $ AllocationR tid ssh ash AUsersR
|
||||
|
||||
siteLayoutMsg MsgAllocationPriorities $ do
|
||||
setTitleI $ MsgAllocationPrioritiesTitle tid ssh ash
|
||||
|
||||
let priosForm = wrapForm priosView def
|
||||
{ formEncoding = priosEnctype
|
||||
, formAction = Just . SomeRoute $ AllocationR tid ssh ash APriosR
|
||||
}
|
||||
gradeScale <- getsYesod $ view _appAllocationGradeScale
|
||||
gradeOrdinalProportion <- getsYesod $ view _appAllocationGradeOrdinalProportion
|
||||
|
||||
$(i18nWidgetFile "allocation-priorities")
|
||||
@ -1,79 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Handler.Allocation.Register
|
||||
( AllocationRegisterForm(..)
|
||||
, AllocationRegisterButton(..)
|
||||
, allocationRegisterForm
|
||||
, allocationUserToForm
|
||||
, postARegisterR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils.Form
|
||||
|
||||
{-# ANN module ("HLint: ignore Use newtype instead of data"::String) #-}
|
||||
|
||||
|
||||
data AllocationRegisterForm = AllocationRegisterForm
|
||||
{ arfTotalCourses :: Word64
|
||||
}
|
||||
|
||||
allocationRegisterForm :: Maybe AllocationRegisterForm -> AForm Handler AllocationRegisterForm
|
||||
allocationRegisterForm template
|
||||
= AllocationRegisterForm
|
||||
<$> areq (posIntFieldI MsgAllocationTotalCoursesNegative) (fslI MsgAllocationTotalCourses & setTooltip MsgAllocationTotalCoursesTip) (arfTotalCourses <$> template <|> Just 1)
|
||||
|
||||
allocationUserToForm :: AllocationUser -> AllocationRegisterForm
|
||||
allocationUserToForm AllocationUser{..} = AllocationRegisterForm
|
||||
{ arfTotalCourses = allocationUserTotalCourses
|
||||
}
|
||||
|
||||
data AllocationRegisterButton = BtnAllocationRegister | BtnAllocationRegistrationEdit
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Universe AllocationRegisterButton
|
||||
instance Finite AllocationRegisterButton
|
||||
|
||||
nullaryPathPiece ''AllocationRegisterButton $ camelToPathPiece' 1
|
||||
embedRenderMessage ''UniWorX ''AllocationRegisterButton id
|
||||
|
||||
instance Button UniWorX AllocationRegisterButton where
|
||||
btnLabel BtnAllocationRegister
|
||||
= [whamlet|
|
||||
$newline never
|
||||
#{iconAllocationRegister} \
|
||||
_{BtnAllocationRegister}
|
||||
|]
|
||||
btnLabel BtnAllocationRegistrationEdit
|
||||
= [whamlet|
|
||||
$newline never
|
||||
#{iconAllocationRegistrationEdit} \
|
||||
_{BtnAllocationRegistrationEdit}
|
||||
|]
|
||||
|
||||
btnClasses _ = [BCIsButton, BCPrimary]
|
||||
|
||||
postARegisterR :: TermId -> SchoolId -> AllocationShorthand -> Handler Void
|
||||
postARegisterR tid ssh ash = do
|
||||
uid <- requireAuthId
|
||||
|
||||
((registerRes, _), _) <- runFormPost . renderAForm FormStandard $ allocationRegisterForm Nothing
|
||||
formResult registerRes $ \AllocationRegisterForm{..} -> runDB $ do
|
||||
aId <- getKeyBy404 $ TermSchoolAllocationShort tid ssh ash
|
||||
isRegistered <- existsBy $ UniqueAllocationUser aId uid
|
||||
void $ upsert AllocationUser
|
||||
{ allocationUserAllocation = aId
|
||||
, allocationUserUser = uid
|
||||
, allocationUserTotalCourses = arfTotalCourses
|
||||
, allocationUserPriority = Nothing
|
||||
}
|
||||
[ AllocationUserTotalCourses =. arfTotalCourses
|
||||
]
|
||||
audit $ TransactionAllocationUserEdited uid aId
|
||||
if
|
||||
| isRegistered -> addMessageI Success MsgAllocationRegistrationEdited
|
||||
| otherwise -> addMessageI Success MsgAllocationRegistered
|
||||
|
||||
redirect $ AllocationR tid ssh ash AShowR :#: ("allocation-participation" :: Text)
|
||||
@ -1,226 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Handler.Allocation.Show
|
||||
( getAShowR, postAShowR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Course
|
||||
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Allocation (allocationNotifyNewCourses)
|
||||
|
||||
import Handler.Allocation.Register
|
||||
import Handler.Allocation.Application
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
|
||||
data NotifyNewCourseButton
|
||||
= BtnNotifyNewCourseForceOn
|
||||
| BtnNotifyNewCourseForceOff
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
deriving anyclass (Universe, Finite)
|
||||
embedRenderMessage ''UniWorX ''NotifyNewCourseButton id
|
||||
nullaryPathPiece ''NotifyNewCourseButton $ camelToPathPiece' 2
|
||||
|
||||
instance Button UniWorX NotifyNewCourseButton where
|
||||
btnLabel BtnNotifyNewCourseForceOn
|
||||
= [whamlet|
|
||||
$newline never
|
||||
#{iconNotification} \
|
||||
_{BtnNotifyNewCourseForceOn}
|
||||
|]
|
||||
btnLabel BtnNotifyNewCourseForceOff
|
||||
= [whamlet|
|
||||
$newline never
|
||||
#{iconNoNotification} \
|
||||
_{BtnNotifyNewCourseForceOff}
|
||||
|]
|
||||
|
||||
btnClasses _ = [BCIsButton]
|
||||
|
||||
|
||||
getAShowR, postAShowR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
|
||||
getAShowR = postAShowR
|
||||
postAShowR tid ssh ash = do
|
||||
muid <- maybeAuthId
|
||||
now <- liftIO getCurrentTime
|
||||
ata <- getSessionActiveAuthTags
|
||||
|
||||
let
|
||||
resultCourse :: _ => Lens' a (Entity Course)
|
||||
resultCourse = _1
|
||||
resultCourseApplication :: _ => Traversal' a (Entity CourseApplication)
|
||||
resultCourseApplication = _2 . _Just
|
||||
resultHasTemplate :: _ => Lens' a Bool
|
||||
resultHasTemplate = _3 . _Value
|
||||
resultIsRegistered :: _ => Lens' a Bool
|
||||
resultIsRegistered = _4 . _Value
|
||||
resultCourseVisible :: _ => Lens' a Bool
|
||||
resultCourseVisible = _5 . _Value
|
||||
resultAllocationCourse :: _ => Lens' a AllocationCourse
|
||||
resultAllocationCourse = _6 . _entityVal
|
||||
resultParticipantCount :: _ => Lens' a Int
|
||||
resultParticipantCount = _7 . _Value
|
||||
resultRatingsCount :: _ => Getter a (Maybe Word64)
|
||||
resultRatingsCount = _8 . _1 . _Value . to (assertM' (> 0))
|
||||
resultVetosCount :: _ => Lens' a Word64
|
||||
resultVetosCount = _8 . _2 . _Value
|
||||
|
||||
(Entity aId Allocation{..}, School{..}, isAnyLecturer, isAdmin, courses, registration, wouldNotifyNewCourse) <- runDB $ do
|
||||
alloc@(Entity aId Allocation{allocationSchool}) <- getBy404 $ TermSchoolAllocationShort tid ssh ash
|
||||
school <- getJust allocationSchool
|
||||
|
||||
courses <- E.select . E.from $ \((allocationCourse `E.InnerJoin` course) `E.LeftOuterJoin` courseApplication `E.LeftOuterJoin` registration) -> do
|
||||
E.on $ registration E.?. CourseParticipantCourse E.==. E.just (course E.^. CourseId)
|
||||
E.&&. registration E.?. CourseParticipantUser E.==. E.val muid
|
||||
E.&&. registration E.?. CourseParticipantState E.==. E.just (E.val CourseParticipantActive)
|
||||
E.on $ courseApplication E.?. CourseApplicationCourse E.==. E.just (course E.^. CourseId)
|
||||
E.&&. courseApplication E.?. CourseApplicationUser E.==. E.val muid
|
||||
E.&&. courseApplication E.?. CourseApplicationAllocation E.==. E.just (E.just $ E.val aId)
|
||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
|
||||
E.&&. ( E.isJust (courseApplication E.?. CourseApplicationId)
|
||||
E.||. mayViewCourse muid ata now course (E.justVal aId)
|
||||
)
|
||||
E.orderBy [E.asc $ course E.^. CourseName]
|
||||
let hasTemplate = E.exists . E.from $ \courseAppInstructionFile ->
|
||||
E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. course E.^. CourseId
|
||||
participantCount = E.subSelectCount . E.from $ \courseParticipant ->
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
||||
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
ratingsCount = E.subSelectCount . E.from $ \courseApplication' -> do
|
||||
E.where_ $ courseApplication' E.^. CourseApplicationCourse E.==. course E.^. CourseId
|
||||
E.&&. courseApplication' E.^. CourseApplicationAllocation E.==. E.justVal aId
|
||||
E.&&. ( E.isJust (courseApplication' E.^. CourseApplicationRatingPoints)
|
||||
E.||. E.isJust (courseApplication' E.^. CourseApplicationRatingComment)
|
||||
E.||. courseApplication' E.^. CourseApplicationRatingVeto
|
||||
)
|
||||
vetosCount = E.subSelectCount . E.from $ \courseApplication' -> do
|
||||
E.where_ $ courseApplication' E.^. CourseApplicationCourse E.==. course E.^. CourseId
|
||||
E.&&. courseApplication' E.^. CourseApplicationAllocation E.==. E.justVal aId
|
||||
E.&&. courseApplication' E.^. CourseApplicationRatingVeto
|
||||
return ( course
|
||||
, courseApplication
|
||||
, hasTemplate
|
||||
, E.not_ . E.isNothing $ registration E.?. CourseParticipantId
|
||||
, courseIsVisible now course $ E.justVal aId
|
||||
, allocationCourse
|
||||
, participantCount
|
||||
, (ratingsCount, vetosCount)
|
||||
)
|
||||
|
||||
registration <- fmap join . for muid $ getBy . UniqueAllocationUser aId
|
||||
|
||||
isAnyLecturer <- hasWriteAccessTo CourseNewR
|
||||
isAdmin <- hasReadAccessTo $ AllocationR tid ssh ash AUsersR
|
||||
|
||||
wouldNotifyNewCourse <- fmap (maybe False E.unValue . join) . for muid $ E.selectMaybe . pure . allocationNotifyNewCourses (E.val aId) . E.val
|
||||
|
||||
return (alloc, school, isAnyLecturer, isAdmin, nubOrdOn (view $ resultCourse . _entityKey) courses, registration, wouldNotifyNewCourse)
|
||||
|
||||
let nextSubstitutesDeadline = minimumOf (folded . resultAllocationCourse . _allocationCourseAcceptSubstitutes . _Just . filtered (>= now)) courses
|
||||
freeCapacity = fmap getSum . getAp . flip foldMap courses $ \cEntry -> Ap . fmap (Sum . max 0) $ subtract (cEntry ^. resultParticipantCount) <$> preview (resultCourse . _entityVal . _courseCapacity . _Just) cEntry
|
||||
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
let title = MsgAllocationTitle (mr . ShortTermIdentifier $ unTermKey allocationTerm) (unSchoolKey allocationSchool) allocationName
|
||||
shortTitle = MsgAllocationShortTitle (mr . ShortTermIdentifier $ unTermKey allocationTerm) (unSchoolKey allocationSchool) allocationShorthand
|
||||
|
||||
-- staffInformation <- anyM courses $ \(view $ resultCourse . _entityVal -> Course{..}) ->
|
||||
-- hasReadAccessTo $ CourseR courseTerm courseSchool courseShorthand CApplicationsR
|
||||
mayRegister <- hasWriteAccessTo $ AllocationR tid ssh ash ARegisterR
|
||||
(registerForm, registerEnctype) <- generateFormPost . identifyForm FIDAllocationRegister . renderAForm FormStandard . allocationRegisterForm $ allocationUserToForm . entityVal <$> registration
|
||||
let
|
||||
registerBtn = bool BtnAllocationRegister BtnAllocationRegistrationEdit $ is _Just registration
|
||||
registerForm' = wrapForm' registerBtn registerForm FormSettings
|
||||
{ formMethod = POST
|
||||
, formAction = Just . SomeRoute $ AllocationR tid ssh ash ARegisterR
|
||||
, formEncoding = registerEnctype
|
||||
, formAttrs = []
|
||||
, formSubmit = FormSubmit
|
||||
, formAnchor = Nothing :: Maybe Text
|
||||
}
|
||||
|
||||
((notificationResult, notificationForm), notificationEnctype) <- runFormPost . identifyForm FIDAllocationNotification . buttonForm' $ if
|
||||
| wouldNotifyNewCourse
|
||||
-> [BtnNotifyNewCourseForceOff]
|
||||
| otherwise
|
||||
-> [BtnNotifyNewCourseForceOn]
|
||||
let
|
||||
allocationNotificationIdent = "allocation-notification" :: Text
|
||||
notificationForm' = wrapForm notificationForm FormSettings
|
||||
{ formMethod = POST
|
||||
, formAction = Just . SomeRoute $ AllocationR tid ssh ash AShowR
|
||||
, formEncoding = notificationEnctype
|
||||
, formAttrs = []
|
||||
, formSubmit = FormNoSubmit
|
||||
, formAnchor = Just allocationNotificationIdent
|
||||
}
|
||||
|
||||
whenIsJust muid $ \uid -> formResult notificationResult $ \notificationBtn -> do
|
||||
let allocationNotificationSettingIsOptOut = case notificationBtn of
|
||||
BtnNotifyNewCourseForceOn -> False
|
||||
BtnNotifyNewCourseForceOff -> True
|
||||
runDB . void $ upsertBy (UniqueAllocationNotificationSetting uid aId) AllocationNotificationSetting
|
||||
{ allocationNotificationSettingUser = uid
|
||||
, allocationNotificationSettingAllocation = aId
|
||||
, allocationNotificationSettingIsOptOut
|
||||
}
|
||||
[ AllocationNotificationSettingIsOptOut =. allocationNotificationSettingIsOptOut ]
|
||||
addMessageI Success $ bool MsgAllocationNotificationNewCourseSuccessForceOn MsgAllocationNotificationNewCourseSuccessForceOff allocationNotificationSettingIsOptOut
|
||||
redirect $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR :#: allocationNotificationIdent
|
||||
|
||||
siteLayoutMsg title $ do
|
||||
setTitleI shortTitle
|
||||
|
||||
let courseWidgets = flip map courses $ \cEntry -> do
|
||||
let Entity cid Course{..} = cEntry ^. resultCourse
|
||||
hasApplicationTemplate = cEntry ^. resultHasTemplate
|
||||
mApp = cEntry ^? resultCourseApplication
|
||||
isRegistered = cEntry ^. resultIsRegistered
|
||||
courseVisible = cEntry ^. resultCourseVisible
|
||||
AllocationCourse{..} = cEntry ^. resultAllocationCourse
|
||||
partCount = cEntry ^. resultParticipantCount
|
||||
mRatings = cEntry ^. resultRatingsCount
|
||||
vetos = cEntry ^. resultVetosCount
|
||||
cID <- encrypt cid :: WidgetFor UniWorX CryptoUUIDCourse
|
||||
mayApply <- hasWriteAccessTo . AllocationR tid ssh ash $ AApplyR cID
|
||||
mayEdit <- hasWriteAccessTo $ CourseR tid ssh courseShorthand CEditR
|
||||
isLecturer <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
|
||||
mApplyFormView <- liftHandler . for muid $ \uid -> generateFormPost $ applicationForm (Just aId) cid (Just uid) (ApplicationFormMode True mayApply isLecturer) . Just
|
||||
tRoute <- case mApp of
|
||||
Nothing -> return . AllocationR tid ssh ash $ AApplyR cID
|
||||
Just (Entity appId _) -> CApplicationR courseTerm courseSchool courseShorthand <$> encrypt appId <*> pure CAEditR
|
||||
mApplicationTemplate <- runMaybeT $ do
|
||||
guard hasApplicationTemplate
|
||||
toTextUrl $ CourseR courseTerm courseSchool courseShorthand CRegisterTemplateR
|
||||
|
||||
let mApplyFormView' = view _1 <$> mApplyFormView
|
||||
overrideVisible = not mayApply && is _Just mApp
|
||||
case mApplyFormView of
|
||||
Just (_, appFormEnctype)
|
||||
-> wrapForm $(widgetFile "allocation/show/course") FormSettings
|
||||
{ formMethod = POST
|
||||
, formAction = Just $ SomeRoute tRoute
|
||||
, formEncoding = appFormEnctype
|
||||
, formAttrs = [ ("class", "allocation-course")
|
||||
]
|
||||
, formSubmit = FormNoSubmit
|
||||
, formAnchor = Just cID
|
||||
}
|
||||
Nothing
|
||||
-> let wdgt = $(widgetFile "allocation/show/course")
|
||||
in [whamlet|
|
||||
<div .allocation-course ##{toPathPiece cID}>
|
||||
^{wdgt}
|
||||
|]
|
||||
let daysToRegistrationStart = assertM (>0) $ (`diffUTCTime` now) <$> allocationRegisterFrom
|
||||
allocationInfoModal = modal [whamlet|_{MsgHeadingAllocationInfo}|] $ Left $ SomeRoute InfoAllocationR
|
||||
numCourses = length courses
|
||||
numAppliedCourses = lengthOf (folded . _2 . _Just) courses
|
||||
$(widgetFile "allocation/show")
|
||||
@ -1,231 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Handler.Allocation.UserForm
|
||||
( AllocationUserForm(..)
|
||||
, allocationUserForm
|
||||
, CourseParticipantForm(..)
|
||||
, _CourseParticipantFormNotAllocated, _CourseParticipantFormDeregistered, _CourseParticipantFormRegistered, _cpfDeregisterReason, _cpfEverRegistered
|
||||
, CourseParticipantForm'
|
||||
, courseParticipantForm
|
||||
) where
|
||||
|
||||
import Import
|
||||
import Handler.Allocation.Application
|
||||
|
||||
import Handler.Utils
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
import qualified Database.Esqueleto.PostgreSQL as E
|
||||
import qualified Data.Map.Strict as Map
|
||||
|
||||
import Text.Blaze (toMarkup)
|
||||
|
||||
|
||||
data AllocationUserForm = AllocationUserForm
|
||||
{ aauUser :: UserId
|
||||
, aauTotalCourses :: Word64
|
||||
, aauPriority :: Maybe AllocationPriority
|
||||
, aauApplications :: Map CourseId ApplicationForm
|
||||
}
|
||||
|
||||
|
||||
allocationUserForm :: forall m backend.
|
||||
( MonadHandler m, HandlerSite m ~ UniWorX
|
||||
, E.SqlBackendCanRead backend, IsSqlBackend backend
|
||||
)
|
||||
=> AllocationId
|
||||
-> Maybe AllocationUserForm
|
||||
-> AForm (ReaderT backend m) AllocationUserForm
|
||||
allocationUserForm aId mTemplate = wFormToAForm $ do
|
||||
allocCourses <- lift . lift . E.select . E.from $ \(course `E.InnerJoin` allocationCourse) -> do
|
||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
|
||||
return ( course
|
||||
, E.exists . E.from $ \courseAppInstructionFile ->
|
||||
E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. course E.^. CourseId
|
||||
, allocationCourse
|
||||
)
|
||||
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
|
||||
userRes <- case aauUser <$> mTemplate of
|
||||
Just u -> do
|
||||
User{..} <- lift . lift $ get404 u
|
||||
fvId <- newIdent
|
||||
lift . tell $ pure FieldView
|
||||
{ fvLabel = toMarkup $ mr MsgAllocationAddUserUser
|
||||
, fvTooltip = Nothing
|
||||
, fvId
|
||||
, fvInput = nameWidget userDisplayName userSurname
|
||||
, fvErrors = Nothing
|
||||
, fvRequired = False
|
||||
}
|
||||
return $ FormSuccess u
|
||||
Nothing -> wreq (checkMap (first $ const MsgAllocationAddUserUserNotFound) Right $ userField False Nothing) (fslpI MsgAllocationAddUserUser (mr MsgAllocationAddUserUserPlaceholder)) Nothing
|
||||
|
||||
totalCoursesRes <- wreq (posIntFieldI MsgAllocationAddUserTotalCoursesLessThanOne) (fslI MsgAllocationAddUserTotalCourses) ((aauTotalCourses <$> mTemplate) <|> Just 1)
|
||||
|
||||
priorityRes <- hoist (hoist liftHandler) $ optionalActionW (allocationPriorityForm (fslI MsgAllocationAddUserPriority) $ aauPriority =<< mTemplate) (fslI MsgAllocationAddUserSetPriority) ((is _Just . aauPriority <$> mTemplate) <|> Just True)
|
||||
|
||||
applicationsRes <- aFormToWForm $ allocationApplicationsForm aId (aauUser <$> mTemplate) (Map.fromList [ (cId, (course, allocationCourse, hasTemplate)) | (Entity cId course, E.Value hasTemplate, Entity _ allocationCourse) <- allocCourses ]) (fslI MsgAllocationAddUserApplications) False
|
||||
|
||||
return $ AllocationUserForm
|
||||
<$> userRes
|
||||
<*> totalCoursesRes
|
||||
<*> priorityRes
|
||||
<*> applicationsRes
|
||||
|
||||
|
||||
allocationApplicationsForm :: forall m backend.
|
||||
( MonadHandler m, HandlerSite m ~ UniWorX
|
||||
, E.SqlBackendCanRead backend
|
||||
)
|
||||
=> AllocationId
|
||||
-> Maybe UserId
|
||||
-> Map CourseId (Course, AllocationCourse, Bool)
|
||||
-> FieldSettings UniWorX
|
||||
-> Bool
|
||||
-> AForm (ReaderT backend m) (Map CourseId ApplicationForm)
|
||||
allocationApplicationsForm aId muid courses FieldSettings{..} fvRequired = formToAForm $ do
|
||||
now <- liftIO getCurrentTime
|
||||
|
||||
let afmApplicant = True
|
||||
afmApplicantEdit = True
|
||||
afmLecturer = True
|
||||
|
||||
appsRes' <- iforM courses $ \cId (course, allocCourse, hasApplicationTemplate) -> do
|
||||
mApplicationTemplate <- runMaybeT $ do
|
||||
guard hasApplicationTemplate
|
||||
let Course{..} = course
|
||||
toTextUrl $ CourseR courseTerm courseSchool courseShorthand CRegisterTemplateR
|
||||
counts <- lift . fmap (maybe (Nothing, 0) $ bimap (assertM' (> 0) . E.unValue) E.unValue) . E.selectMaybe . E.from $ \courseApplication -> do
|
||||
E.where_ $ courseApplication E.^. CourseApplicationCourse E.==. E.val cId
|
||||
E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.justVal aId
|
||||
let hasRating = E.isJust (courseApplication E.^. CourseApplicationRatingPoints)
|
||||
E.||. E.isJust (courseApplication E.^. CourseApplicationRatingComment)
|
||||
E.||. courseApplication E.^. CourseApplicationRatingVeto
|
||||
return ( E.count (courseApplication E.^. CourseApplicationId) `E.filterWhere` hasRating
|
||||
, E.count (courseApplication E.^. CourseApplicationId) `E.filterWhere` (courseApplication E.^. CourseApplicationRatingVeto)
|
||||
)
|
||||
hoist liftHandler $ over _2 (course, allocCourse, mApplicationTemplate, counts, ) <$> applicationForm (Just aId) cId muid ApplicationFormMode{..} Nothing
|
||||
let appsRes = sequenceA $ view _1 <$> appsRes'
|
||||
appsViews = view _2 <$> appsRes'
|
||||
|
||||
let fvInput =
|
||||
[whamlet|
|
||||
$newline never
|
||||
<div .allocation__courses>
|
||||
$forall (Course{courseTerm, courseSchool, courseShorthand, courseName, courseApplicationsInstructions}, AllocationCourse{allocationCourseAcceptSubstitutes}, mApplicationTemplate, (mRatings, vetos), ApplicationFormView{afvPriority, afvForm}) <- Map.elems appsViews
|
||||
<div .allocation-course>
|
||||
<div .allocation-course__priority-label .allocation__label>
|
||||
_{MsgAllocationPriority}
|
||||
<div .allocation-course__priority>
|
||||
$maybe prioView <- afvPriority
|
||||
^{fvWidget prioView}
|
||||
<a .allocation-course__name href=@{CourseR courseTerm courseSchool courseShorthand CShowR} target="_blank">
|
||||
#{courseName}
|
||||
<div .allocation-course__admin-info>
|
||||
<p>
|
||||
$maybe deadline <- allocationCourseAcceptSubstitutes
|
||||
_{MsgCourseAllocationCourseAcceptsSubstitutesUntil}: #
|
||||
^{formatTimeW SelFormatDateTime deadline}
|
||||
$nothing
|
||||
_{MsgCourseAllocationCourseAcceptsSubstitutesNever}
|
||||
$if allocationCourseAcceptSubstitutes >= Just now
|
||||
\ ^{iconOK}
|
||||
$maybe ratings <- mRatings
|
||||
^{notification NotificationBroad =<< messageI Warning (MsgAllocationCourseHasRatings ratings vetos)}
|
||||
$if is _Just mApplicationTemplate || is _Just courseApplicationsInstructions
|
||||
<div .allocation-course__instructions-label .allocation__label>
|
||||
_{MsgCourseAllocationApplicationInstructionsApplication}
|
||||
<div .allocation-course__instructions>
|
||||
$maybe aInst <- courseApplicationsInstructions
|
||||
<p>
|
||||
#{aInst}
|
||||
$maybe templateUrl <- mApplicationTemplate
|
||||
<p>
|
||||
<a href=#{templateUrl}>
|
||||
#{iconRegisterTemplate} _{MsgCourseAllocationApplicationTemplateApplication}
|
||||
<div .allocation-course__application-label .interactive-fieldset__target .allocation__label uw-interactive-fieldset data-conditional-input=#{maybe "" fvId afvPriority} data-conditional-value="" data-conditional-negated>
|
||||
_{MsgCourseApplication}
|
||||
<div .allocation-course__application .interactive-fieldset__target uw-interactive-fieldset data-conditional-input=#{maybe "" fvId afvPriority} data-conditional-value="" data-conditional-negated>
|
||||
^{renderFieldViews FormStandard afvForm}
|
||||
|]
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
let fvLabel = toHtml $ mr fsLabel
|
||||
fvTooltip = toHtml . mr <$> fsTooltip
|
||||
fvErrors = case appsRes of
|
||||
FormFailure errs -> Just
|
||||
[shamlet|
|
||||
$newline never
|
||||
<ul>
|
||||
$forall err <- errs
|
||||
<li>#{err}
|
||||
|]
|
||||
_other -> Nothing
|
||||
fvId <- maybe newIdent return fsId
|
||||
|
||||
return (appsRes, pure FieldView{..})
|
||||
|
||||
|
||||
data CourseParticipantForm
|
||||
= CourseParticipantFormNotAllocated -- ^ User is registered but not through allocation; no control
|
||||
| CourseParticipantFormDeregistered -- ^ User is not currently registered
|
||||
{ cpfDeregisterReason :: Maybe Text -- ^ `Just` if user was deregistered "self-inflicted", reason is required
|
||||
, cpfEverRegistered :: Bool
|
||||
}
|
||||
| CourseParticipantFormRegistered -- ^ User is currently registered
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
|
||||
type CourseParticipantForm' = Map CourseId CourseParticipantForm
|
||||
|
||||
makePrisms ''CourseParticipantForm
|
||||
makeLenses_ ''CourseParticipantForm
|
||||
|
||||
courseParticipantForm :: forall m.
|
||||
( MonadHandler m, HandlerSite m ~ UniWorX )
|
||||
=> Map CourseId ((TermId, SchoolId, CourseShorthand), CourseName, CourseParticipantForm)
|
||||
-> (Html -> MForm m (FormResult CourseParticipantForm', Widget))
|
||||
courseParticipantForm courses csrf = do
|
||||
lines' <- iforM courses $ \_cId ((tid, ssh, csh), cname, prevSt)
|
||||
-> let toLine fCell = $(widgetFile "allocation/user-course-participant-form/line")
|
||||
in over _2 toLine <$> case prevSt of
|
||||
CourseParticipantFormNotAllocated -> do
|
||||
(_, isRegView) <- mforced checkBoxField def True
|
||||
return ( FormSuccess CourseParticipantFormNotAllocated
|
||||
, $(widgetFile "allocation/user-course-participant-form/not-allocated")
|
||||
)
|
||||
_other -> do
|
||||
let deregReason = prevSt ^? _cpfDeregisterReason . _Just
|
||||
isRegPrev = is _CourseParticipantFormRegistered prevSt
|
||||
everRegistered = fromMaybe True $ prevSt ^? _cpfEverRegistered
|
||||
(isRegRes, isRegView) <- mpopt checkBoxField def $ Just isRegPrev
|
||||
let selfInflictedFS = def
|
||||
& addAttr "uw-interactive-fieldset" ""
|
||||
& addAttr "data-conditional-input" (fvId isRegView)
|
||||
& addAttr "data-conditional-negated" ""
|
||||
(isSelfInflictedRes, isSelfInflictedView) <- if
|
||||
| everRegistered -> over _2 Just <$> mopt (textField & cfStrip) selfInflictedFS (Just deregReason)
|
||||
| otherwise -> return (FormSuccess Nothing, Nothing)
|
||||
return ( case isRegRes of
|
||||
FormMissing -> FormMissing
|
||||
FormFailure es1 -> FormFailure $ es1 <> view _FormFailure isSelfInflictedRes
|
||||
FormSuccess True
|
||||
| FormFailure es2 <- isSelfInflictedRes
|
||||
-> FormFailure es2
|
||||
| otherwise
|
||||
-> FormSuccess CourseParticipantFormRegistered
|
||||
FormSuccess False
|
||||
-> CourseParticipantFormDeregistered <$> isSelfInflictedRes <*> pure everRegistered
|
||||
, $(widgetFile "allocation/user-course-participant-form/cell")
|
||||
)
|
||||
let linesWidget = Map.intersectionWith (,) courses lines'
|
||||
& Map.elems
|
||||
& sortOn (view $ _1 . _1)
|
||||
& view (folded . _2 . _2)
|
||||
return ( forM lines' $ view _1
|
||||
, $(widgetFile "allocation/user-course-participant-form/layout")
|
||||
)
|
||||
@ -1,350 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
|
||||
|
||||
module Handler.Allocation.Users
|
||||
( getAUsersR, postAUsersR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Allocation.Accept
|
||||
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Allocation
|
||||
import Handler.Utils.StudyFeatures
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import qualified Data.Csv as Csv
|
||||
|
||||
import Data.Map ((!?))
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import Text.Blaze (toMarkup)
|
||||
|
||||
import qualified Data.Conduit.Combinators as C
|
||||
|
||||
|
||||
type UserTableExpr = E.SqlExpr (Entity User)
|
||||
`E.InnerJoin` E.SqlExpr (Entity AllocationUser)
|
||||
|
||||
queryUser :: Getter UserTableExpr (E.SqlExpr (Entity User))
|
||||
queryUser = to $(E.sqlIJproj 2 1)
|
||||
|
||||
queryAllocationUser :: Getter UserTableExpr (E.SqlExpr (Entity AllocationUser))
|
||||
queryAllocationUser = to $(E.sqlIJproj 2 2)
|
||||
|
||||
queryAppliedCourses :: Getter UserTableExpr (E.SqlExpr (E.Value Int))
|
||||
queryAppliedCourses = queryAllocationUser . to queryAppliedCourses'
|
||||
where queryAppliedCourses' allocationUser = E.subSelectCount . E.from $ \(courseApplication `E.InnerJoin` allocationCourse) -> do
|
||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. courseApplication E.^. CourseApplicationCourse
|
||||
E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
|
||||
E.where_ $ courseApplication E.^. CourseApplicationUser E.==. allocationUser E.^. AllocationUserUser
|
||||
E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocationUser E.^. AllocationUserAllocation)
|
||||
|
||||
queryAssignedCourses :: Getter UserTableExpr (E.SqlExpr (E.Value Int))
|
||||
queryAssignedCourses = queryAllocationUser . to queryAssignedCourses'
|
||||
where queryAssignedCourses' allocationUser = E.subSelectCount . E.from $ \courseParticipant ->
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. allocationUser E.^. AllocationUserUser
|
||||
E.&&. courseParticipant E.^. CourseParticipantAllocated E.==. E.just (allocationUser E.^. AllocationUserAllocation)
|
||||
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
|
||||
queryVetoedCourses :: Getter UserTableExpr (E.SqlExpr (E.Value Int))
|
||||
queryVetoedCourses = queryAllocationUser . to queryVetoedCourses'
|
||||
where queryVetoedCourses' allocationUser = E.subSelectCount . E.from $ \(courseApplication `E.InnerJoin` allocationCourse) -> do
|
||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. courseApplication E.^. CourseApplicationCourse
|
||||
E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
|
||||
E.where_ $ courseApplication E.^. CourseApplicationUser E.==. allocationUser E.^. AllocationUserUser
|
||||
E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocationUser E.^. AllocationUserAllocation)
|
||||
E.where_ $ courseApplication E.^. CourseApplicationRatingVeto
|
||||
E.||. courseApplication E.^. CourseApplicationRatingPoints `E.in_` E.valList (map Just $ filter (view $ passingGrade . _Wrapped . to not) universeF)
|
||||
|
||||
|
||||
type UserTableData = DBRow ( Entity User
|
||||
, UserTableStudyFeatures
|
||||
, Entity AllocationUser
|
||||
, Int
|
||||
, Int
|
||||
, Int
|
||||
)
|
||||
-- ^ `Int`s are applied, assigned, vetoed in that order
|
||||
|
||||
resultUser :: Lens' UserTableData (Entity User)
|
||||
resultUser = _dbrOutput . _1
|
||||
|
||||
resultStudyFeatures :: Lens' UserTableData UserTableStudyFeatures
|
||||
resultStudyFeatures = _dbrOutput . _2
|
||||
|
||||
resultAllocationUser :: Lens' UserTableData (Entity AllocationUser)
|
||||
resultAllocationUser = _dbrOutput . _3
|
||||
|
||||
resultAppliedCourses, resultAssignedCourses, resultVetoedCourses :: Lens' UserTableData Int
|
||||
resultAppliedCourses = _dbrOutput . _4
|
||||
resultAssignedCourses = _dbrOutput . _5
|
||||
resultVetoedCourses = _dbrOutput . _6
|
||||
|
||||
|
||||
data AllocationUserTableCsv = AllocationUserTableCsv
|
||||
{ csvAUserSurname :: Text
|
||||
, csvAUserFirstName :: Text
|
||||
, csvAUserName :: Text
|
||||
, csvAUserMatriculation :: Maybe Text
|
||||
, csvAUserStudyFeatures :: UserTableStudyFeatures
|
||||
, csvAUserRequested
|
||||
, csvAUserApplied
|
||||
, csvAUserVetos
|
||||
, csvAUserAssigned :: Natural
|
||||
, csvAUserNewAssigned :: Maybe Natural
|
||||
, csvAUserPriority :: Maybe AllocationPriority
|
||||
} deriving (Generic)
|
||||
makeLenses_ ''AllocationUserTableCsv
|
||||
|
||||
allocationUserTableCsvOptions :: Csv.Options
|
||||
allocationUserTableCsvOptions = Csv.defaultOptions { Csv.fieldLabelModifier = camelToPathPiece' 3}
|
||||
|
||||
instance Csv.ToNamedRecord AllocationUserTableCsv where
|
||||
toNamedRecord AllocationUserTableCsv{..} = Csv.namedRecord $
|
||||
[ "surname" Csv..= csvAUserSurname
|
||||
, "first-name" Csv..= csvAUserFirstName
|
||||
, "name" Csv..= csvAUserName
|
||||
, "matriculation" Csv..= csvAUserMatriculation
|
||||
, "study-features" Csv..= csvAUserStudyFeatures
|
||||
, "requested" Csv..= csvAUserRequested
|
||||
, "applied" Csv..= csvAUserApplied
|
||||
, "vetos" Csv..= csvAUserVetos
|
||||
, "assigned" Csv..= csvAUserAssigned
|
||||
] ++
|
||||
[ "new-assigned" Csv..= newAssigned
|
||||
| newAssigned <- hoistMaybe csvAUserNewAssigned
|
||||
] ++
|
||||
[ "priority" Csv..= csvAUserPriority
|
||||
]
|
||||
|
||||
instance CsvColumnsExplained AllocationUserTableCsv where
|
||||
csvColumnsExplanations = genericCsvColumnsExplanations allocationUserTableCsvOptions $ mconcat
|
||||
[ singletonMap 'csvAUserSurname MsgCsvColumnAllocationUserSurname
|
||||
, singletonMap 'csvAUserFirstName MsgCsvColumnAllocationUserFirstName
|
||||
, singletonMap 'csvAUserName MsgCsvColumnAllocationUserName
|
||||
, singletonMap 'csvAUserMatriculation MsgCsvColumnAllocationUserMatriculation
|
||||
, singletonMap 'csvAUserStudyFeatures MsgCsvColumnAllocationUserStudyFeatures
|
||||
, singletonMap 'csvAUserRequested MsgCsvColumnAllocationUserRequested
|
||||
, singletonMap 'csvAUserApplied MsgCsvColumnAllocationUserApplied
|
||||
, singletonMap 'csvAUserVetos MsgCsvColumnAllocationUserVetos
|
||||
, singletonMap 'csvAUserAssigned MsgCsvColumnAllocationUserAssigned
|
||||
, singletonMap 'csvAUserNewAssigned MsgCsvColumnAllocationUserNewAssigned
|
||||
, singletonMap 'csvAUserPriority MsgCsvColumnAllocationUserPriority
|
||||
]
|
||||
|
||||
userTableCsvHeader :: Bool -> Csv.Header
|
||||
userTableCsvHeader hasNewAssigned = Csv.header $
|
||||
[ "surname"
|
||||
, "first-name"
|
||||
, "name"
|
||||
, "matriculation"
|
||||
, "study-features"
|
||||
, "requested"
|
||||
, "applied"
|
||||
, "vetos"
|
||||
, "assigned"
|
||||
] ++
|
||||
[ "new-assigned"
|
||||
| hasNewAssigned
|
||||
] ++
|
||||
[ "priority"
|
||||
]
|
||||
|
||||
|
||||
getAUsersR, postAUsersR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
|
||||
getAUsersR = postAUsersR
|
||||
postAUsersR tid ssh ash = do
|
||||
(usersTable, acceptForm) <- runDB $ do
|
||||
Entity aId _ <- getBy404 $ TermSchoolAllocationShort tid ssh ash
|
||||
resultsDone <- is _Just <$> allocationStarted aId
|
||||
allocMatching <- runMaybeT $ do
|
||||
SessionDataAllocationResults allocMap <- MaybeT $ lookupSessionJson SessionAllocationResults
|
||||
allocMatching <- fmap (view _4) . hoistMaybe $ allocMap !? (tid, ssh, ash)
|
||||
return $ Map.fromListWith (<>) [ (uid, opoint cid) | (uid, cid) <- Set.toList allocMatching ] :: _ (Map UserId (NonNull (Set CourseId)))
|
||||
|
||||
let
|
||||
allocationUsersDBTable = DBTable{..}
|
||||
where
|
||||
dbtSQLQuery = runReaderT $ do
|
||||
user <- view queryUser
|
||||
allocationUser <- view queryAllocationUser
|
||||
applied <- view queryAppliedCourses
|
||||
assigned <- view queryAssignedCourses
|
||||
vetoed <- view queryVetoedCourses
|
||||
|
||||
lift $ do
|
||||
E.on $ user E.^. UserId E.==. allocationUser E.^. AllocationUserUser
|
||||
E.&&. allocationUser E.^. AllocationUserAllocation E.==. E.val aId
|
||||
E.where_ $ applied E.>. E.val 0
|
||||
E.||. assigned E.>. E.val 0
|
||||
|
||||
return ( user
|
||||
, allocationUser
|
||||
, applied
|
||||
, assigned
|
||||
, vetoed)
|
||||
dbtRowKey = views queryAllocationUser (E.^. AllocationUserId)
|
||||
dbtProj = dbtProjSimple . runReaderT $ do
|
||||
feats <- lift . allocationUserStudyFeatures aId =<< views _1 entityKey
|
||||
(,,,,,)
|
||||
<$> view _1 <*> pure feats <*> view _2 <*> view (_3 . _Value) <*> view (_4 . _Value) <*> view (_5 . _Value)
|
||||
dbtColonnade :: Colonnade Sortable _ _
|
||||
dbtColonnade = mconcat . catMaybes $
|
||||
[ pure . sortable (Just "user-name") (i18nCell MsgUserDisplayName) $ \(view resultUser -> Entity uid User{..})
|
||||
-> let mkUrl = do
|
||||
cID <- encrypt uid
|
||||
return . AllocationR tid ssh ash $ AEditUserR cID
|
||||
in anchorCellM mkUrl (nameWidget userDisplayName userSurname)
|
||||
, pure $ colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
|
||||
, pure $ colStudyFeatures resultStudyFeatures
|
||||
, pure $ colAllocationRequested (resultAllocationUser . _entityVal . _allocationUserTotalCourses . _Integral)
|
||||
, pure . coursesModalApplied $ colAllocationApplied resultAppliedCourses
|
||||
, pure . coursesModalVetoed $ colAllocationVetoed resultVetoedCourses
|
||||
, guardOn resultsDone . coursesModalAssigned . bool id (assignedHeated $ view resultAssignedCourses) resultsDone $ colAllocationAssigned resultAssignedCourses
|
||||
, coursesModalNewAssigned <$> do
|
||||
allocMatching' <- allocMatching
|
||||
let newAssigned uid = maybe 0 olength $ allocMatching' !? uid
|
||||
pure . assignedHeated (views (resultUser . _entityKey) newAssigned) . sortable (Just "new-assigned") (i18nCell MsgAllocationUserNewMatches) .
|
||||
views (resultUser . _entityKey) $ cell . toWidget . toMarkup . newAssigned
|
||||
, pure $ emptyOpticColonnade' emptyPriorityCell (resultAllocationUser . _entityVal . _allocationUserPriority . _Just) colAllocationPriority
|
||||
]
|
||||
where
|
||||
emptyPriorityCell = addCellClass ("table__td--center" :: Text) . cell $
|
||||
messageTooltip =<< messageIconI Error IconMissingAllocationPriority MsgAllocationMissingPrioritiesIgnored
|
||||
assignedHeated fAssigned = imapColonnade assignedHeated'
|
||||
where
|
||||
assignedHeated' res
|
||||
= let maxAssign = min (res ^. resultAllocationUser . _entityVal . _allocationUserTotalCourses . to fromIntegral)
|
||||
(res ^. resultAppliedCourses)
|
||||
assigned = fAssigned res
|
||||
in cellAttrs <>~ [ ("class", "heated")
|
||||
, ("style", [st|--hotness: #{tshow (coHeat maxAssign assigned)}|])
|
||||
]
|
||||
coursesModalApplied = coursesModal $ \res -> E.from $ \(course `E.InnerJoin` courseApplication) -> do
|
||||
E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
|
||||
E.where_ $ courseApplication E.^. CourseApplicationAllocation E.==. E.val (Just aId)
|
||||
E.&&. courseApplication E.^. CourseApplicationUser E.==. E.val (res ^. resultUser . _entityKey)
|
||||
E.orderBy [E.desc $ courseApplication E.^. CourseApplicationAllocationPriority]
|
||||
return ( course
|
||||
, courseApplication E.^. CourseApplicationRatingPoints
|
||||
, E.just $ courseApplication E.^. CourseApplicationRatingVeto
|
||||
, E.exists . E.from $ \allocationCourse ->
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
|
||||
)
|
||||
coursesModalVetoed = coursesModal $ \res -> E.from $ \(course `E.InnerJoin` courseApplication) -> do
|
||||
E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
|
||||
E.where_ $ courseApplication E.^. CourseApplicationAllocation E.==. E.val (Just aId)
|
||||
E.&&. courseApplication E.^. CourseApplicationUser E.==. E.val (res ^. resultUser . _entityKey)
|
||||
E.where_ $ courseApplication E.^. CourseApplicationRatingVeto
|
||||
E.||. courseApplication E.^. CourseApplicationRatingPoints `E.in_` E.valList (map Just $ filter (view $ passingGrade . _Wrapped . to not) universeF)
|
||||
return ( course
|
||||
, E.nothing
|
||||
, E.nothing
|
||||
, E.exists . E.from $ \allocationCourse ->
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
|
||||
)
|
||||
coursesModalAssigned = coursesModal $ \res -> E.from $ \(course `E.InnerJoin` courseParticipant) -> do
|
||||
E.on $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
||||
E.&&. courseParticipant E.^. CourseParticipantAllocated E.==. E.val (Just aId)
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val (res ^. resultUser . _entityKey)
|
||||
E.orderBy [E.asc $ courseParticipant E.^. CourseParticipantRegistration]
|
||||
return ( course
|
||||
, E.nothing
|
||||
, E.nothing
|
||||
, courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
)
|
||||
coursesModalNewAssigned = coursesModal $ \res -> E.from $ \course -> do
|
||||
E.where_ $ course E.^. CourseId `E.in_` E.valList (maybe [] otoList $ Map.lookup (res ^. resultUser . _entityKey) =<< allocMatching)
|
||||
return ( course
|
||||
, E.nothing
|
||||
, E.nothing
|
||||
, E.true
|
||||
)
|
||||
coursesModal :: (_ -> E.SqlQuery (E.SqlExpr (Entity Course), E.SqlExpr (E.Value (Maybe ExamGrade)), E.SqlExpr (E.Value (Maybe Bool)), E.SqlExpr (E.Value Bool))) -> _ -> _
|
||||
coursesModal courseSel = imapColonnade coursesModal'
|
||||
where
|
||||
coursesModal' res innerCell = review dbCell . (innerCell ^. cellAttrs, ) $ do
|
||||
courses <- lift . E.select $ courseSel res
|
||||
contents <- innerCell ^. cellContents
|
||||
return $ if
|
||||
| null courses -> contents
|
||||
| otherwise -> let tooltipContent = $(widgetFile "table/cell/allocation-courses")
|
||||
in $(widgetFile "widgets/tooltip_no-handle")
|
||||
dbtSorting = mconcat
|
||||
[ sortUserName' $ queryUser . $(multifocusG 2) (to (E.^. UserDisplayName)) (to (E.^. UserSurname))
|
||||
, sortUserMatriculation $ queryUser . to (E.^. UserMatrikelnummer)
|
||||
, sortAllocationApplied queryAppliedCourses
|
||||
, sortAllocationAssigned queryAssignedCourses
|
||||
, sortAllocationRequested $ queryAllocationUser . to (E.^. AllocationUserTotalCourses)
|
||||
, sortAllocationVetoed queryVetoedCourses
|
||||
, sortAllocationPriority $ queryAllocationUser . to (E.^. AllocationUserPriority)
|
||||
, singletonMap "new-assigned" $
|
||||
SortProjected . comparing $ (\uid -> maybe 0 olength $ Map.lookup uid =<< allocMatching) . view (resultUser . _entityKey)
|
||||
]
|
||||
dbtFilter = mconcat
|
||||
[ fltrUserName' $ queryUser . to (E.^. UserDisplayName)
|
||||
, fltrUserMatriculation $ queryUser . to (E.^. UserMatrikelnummer)
|
||||
]
|
||||
dbtFilterUI = mconcat
|
||||
[ fltrUserNameUI'
|
||||
, fltrUserMatriculationUI
|
||||
]
|
||||
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
|
||||
dbtParams = def
|
||||
dbtIdent :: Text
|
||||
dbtIdent = "allocation-users"
|
||||
dbtCsvName = MsgAllocationUsersCsvName tid ssh ash
|
||||
dbtCsvSheetName = MsgAllocationUsersCsvSheetName tid ssh ash
|
||||
dbtCsvEncode = return DBTCsvEncode
|
||||
{ dbtCsvExportForm = pure ()
|
||||
, dbtCsvDoEncode = \() -> C.mapM $ \(_, row) -> flip runReaderT row $
|
||||
AllocationUserTableCsv
|
||||
<$> view (resultUser . _entityVal . _userSurname)
|
||||
<*> view (resultUser . _entityVal . _userFirstName)
|
||||
<*> view (resultUser . _entityVal . _userDisplayName)
|
||||
<*> view (resultUser . _entityVal . _userMatrikelnummer)
|
||||
<*> view resultStudyFeatures
|
||||
<*> view (resultAllocationUser . _entityVal . _allocationUserTotalCourses . _Integral)
|
||||
<*> view (resultAppliedCourses . _Integral)
|
||||
<*> view (resultVetoedCourses . _Integral)
|
||||
<*> view (resultAssignedCourses . _Integral)
|
||||
<*> views (resultUser . _entityKey) (\uid -> maybe 0 (fromIntegral . olength) . Map.lookup uid <$> allocMatching)
|
||||
<*> view (resultAllocationUser . _entityVal . _allocationUserPriority)
|
||||
, dbtCsvName, dbtCsvSheetName
|
||||
, dbtCsvNoExportData = Just id
|
||||
, dbtCsvHeader = \_ -> return . userTableCsvHeader $ is _Just allocMatching
|
||||
, dbtCsvExampleData = Nothing
|
||||
}
|
||||
dbtCsvDecode = Nothing
|
||||
dbtExtraReps = []
|
||||
allocationUsersDBTableValidator = def
|
||||
& defaultSorting [SortAscBy "priority", SortAscBy "user-matriculation"]
|
||||
& defaultPagesize (PagesizeLimit 500)
|
||||
|
||||
usersTable <- dbTableDB' allocationUsersDBTableValidator allocationUsersDBTable
|
||||
|
||||
acceptForm <- allocationAcceptForm aId
|
||||
|
||||
return (usersTable, acceptForm)
|
||||
|
||||
acceptView <- for acceptForm $ \acceptForm' -> do
|
||||
(acceptWgt, acceptEnctype) <- generateFormPost acceptForm'
|
||||
return $ wrapForm' BtnAllocationAccept acceptWgt def
|
||||
{ formAction = Just . SomeRoute $ AllocationR tid ssh ash AAcceptR
|
||||
, formEncoding = acceptEnctype
|
||||
}
|
||||
|
||||
siteLayoutMsg MsgAllocationUsers $ do
|
||||
setTitleI $ MsgAllocationUsersTitle tid ssh ash
|
||||
|
||||
$(widgetFile "allocation/users")
|
||||
@ -21,7 +21,6 @@ import Handler.Course.Register as Handler.Course
|
||||
import Handler.Course.Show as Handler.Course
|
||||
import Handler.Course.User as Handler.Course
|
||||
import Handler.Course.Users as Handler.Course
|
||||
import Handler.Course.Application as Handler.Course
|
||||
import Handler.ExamOffice.Course as Handler.Course
|
||||
import Handler.Course.News as Handler.Course
|
||||
import Handler.Course.Events as Handler.Course
|
||||
|
||||
@ -1,11 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Handler.Course.Application
|
||||
( module Handler.Course.Application
|
||||
) where
|
||||
|
||||
import Handler.Course.Application.List as Handler.Course.Application
|
||||
import Handler.Course.Application.Files as Handler.Course.Application
|
||||
import Handler.Course.Application.Edit as Handler.Course.Application
|
||||
@ -1,62 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Handler.Course.Application.Edit
|
||||
( getCAEditR, postCAEditR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils
|
||||
import Handler.Allocation.Application
|
||||
|
||||
|
||||
getCAEditR, postCAEditR :: TermId -> SchoolId -> CourseShorthand -> CryptoFileNameCourseApplication -> Handler Html
|
||||
getCAEditR = postCAEditR
|
||||
postCAEditR tid ssh csh cID = do
|
||||
uid <- requireAuthId
|
||||
appId <- decrypt cID
|
||||
(mAlloc, Entity cid Course{..}, CourseApplication{..}, User{..}) <- runDB $ do
|
||||
course <- getBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
app <- get404 appId
|
||||
mAlloc <- traverse getEntity404 $ courseApplicationAllocation app
|
||||
appUser <- get404 $ courseApplicationUser app
|
||||
return (mAlloc, course, app, appUser)
|
||||
|
||||
isAdmin <- case mAlloc of
|
||||
Just (Entity _ Allocation{..})
|
||||
-> hasWriteAccessTo $ AllocationR allocationTerm allocationSchool allocationShorthand AEditR
|
||||
Nothing
|
||||
-> hasWriteAccessTo $ SchoolR courseSchool SchoolEditR
|
||||
let afmApplicant = uid == courseApplicationUser || isAdmin
|
||||
afmLecturer <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
|
||||
mayEdit <- hasWriteAccessTo $ CApplicationR tid ssh csh cID CAEditR
|
||||
courseCID <- encrypt cid :: Handler CryptoUUIDCourse
|
||||
|
||||
let afMode = ApplicationFormMode
|
||||
{ afmApplicant
|
||||
, afmApplicantEdit = afmApplicant && mayEdit
|
||||
, afmLecturer
|
||||
}
|
||||
|
||||
(ApplicationFormView{..}, appEnc) <- editApplicationR (entityKey <$> mAlloc) courseApplicationUser cid (Just appId) afMode (/= BtnAllocationApply) $ if
|
||||
| uid == courseApplicationUser
|
||||
, Just (Entity _ Allocation{..}) <- mAlloc
|
||||
-> SomeRoute $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR :#: courseCID
|
||||
| otherwise
|
||||
-> SomeRoute $ CApplicationR tid ssh csh cID CAEditR
|
||||
|
||||
let title = MsgCourseApplicationTitle userDisplayName courseShorthand
|
||||
|
||||
siteLayoutMsg title $ do
|
||||
setTitleI title
|
||||
|
||||
wrapForm ((<> snd afvButtons) . renderFieldViews FormStandard . maybe id (:) afvPriority$ afvForm) FormSettings
|
||||
{ formMethod = POST
|
||||
, formAction = Just . SomeRoute $ CApplicationR tid ssh csh cID CAEditR
|
||||
, formEncoding = appEnc
|
||||
, formAttrs = []
|
||||
, formSubmit = FormNoSubmit
|
||||
, formAnchor = Nothing :: Maybe Text
|
||||
}
|
||||
@ -1,111 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
|
||||
|
||||
module Handler.Course.Application.Files
|
||||
( getCAFilesR
|
||||
, getCAppsFilesR
|
||||
) where
|
||||
|
||||
import Import
|
||||
import Handler.Utils
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
|
||||
getCAFilesR :: TermId -> SchoolId -> CourseShorthand -> CryptoFileNameCourseApplication -> Handler TypedContent
|
||||
getCAFilesR tid ssh csh cID = do
|
||||
appId <- decrypt cID
|
||||
User{..} <- runDB $ do
|
||||
CourseApplication{..} <- get404 appId
|
||||
Course{..} <- get404 courseApplicationCourse
|
||||
let matches = and
|
||||
[ tid == courseTerm
|
||||
, ssh == courseSchool
|
||||
, csh == courseShorthand
|
||||
]
|
||||
unless matches . redirectWith movedPermanently301 $ CApplicationR courseTerm courseSchool courseShorthand cID CAFilesR
|
||||
get404 courseApplicationUser
|
||||
|
||||
archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack) . ap getMessageRender . pure $ MsgCourseApplicationArchiveName tid ssh csh cID userDisplayName
|
||||
let
|
||||
fsSource = E.selectSource . E.from $ \courseApplicationFile -> do
|
||||
E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. E.val appId
|
||||
return courseApplicationFile
|
||||
|
||||
serveSomeFiles archiveName $ fsSource .| C.map entityVal
|
||||
|
||||
|
||||
getCAppsFilesR :: TermId -> SchoolId -> CourseShorthand -> Handler TypedContent
|
||||
getCAppsFilesR tid ssh csh = do
|
||||
runDB . existsBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
|
||||
archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack) . ap getMessageRender . pure $ MsgCourseAllApplicationsArchiveName tid ssh csh
|
||||
|
||||
let
|
||||
fsSource :: ConduitT () CourseApplicationFile DB ()
|
||||
fsSource = do
|
||||
apps <- lift . E.select . E.from $ \((course `E.InnerJoin` courseApplication `E.InnerJoin` user) `E.LeftOuterJoin` allocation) -> do
|
||||
E.on $ allocation E.?. AllocationId E.==. courseApplication E.^. CourseApplicationAllocation
|
||||
E.on $ user E.^. UserId E.==. courseApplication E.^. CourseApplicationUser
|
||||
E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
|
||||
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
|
||||
return (allocation, user, courseApplication)
|
||||
apps' <- flip filterM apps $ \(_, _, Entity appId _) -> do
|
||||
cID <- encrypt appId
|
||||
lift . hasReadAccessTo $ CApplicationR tid ssh csh cID CAFilesR
|
||||
let
|
||||
applicationAllocs = setOf (folded . _1) apps'
|
||||
|
||||
allocations = applicationAllocs ^.. folded . _Just . _entityVal . $(multifocusG 3) _allocationTerm _allocationSchool _allocationShorthand
|
||||
|
||||
allEqualOn :: Eq x => Getter _ x -> Bool
|
||||
allEqualOn l = maybe True (\x -> allOf (folded . l) (== x) allocations) (allocations ^? _head . l)
|
||||
|
||||
mkAllocationDir mbAlloc
|
||||
| not $ allEqualOn _1
|
||||
, Just Allocation{..} <- mbAlloc
|
||||
= (</>) $ unpack [st|#{CI.foldCase (termToText (unTermKey allocationTerm))}-#{CI.foldedCase (unSchoolKey allocationSchool)}-#{CI.foldedCase allocationShorthand}|]
|
||||
| not $ allEqualOn _2
|
||||
, Just Allocation{..} <- mbAlloc
|
||||
= (</>) $ unpack [st|#{CI.foldedCase (unSchoolKey allocationSchool)}-#{CI.foldedCase allocationShorthand}|]
|
||||
| not $ allEqualOn _3
|
||||
, Just Allocation{..} <- mbAlloc
|
||||
= (</>) . unpack $ CI.foldedCase allocationShorthand
|
||||
| Just Allocation{} <- mbAlloc
|
||||
, not $ all (is _Just) applicationAllocs
|
||||
= (</>) . unpack $ mr MsgCourseApplicationsAllocatedDirectory
|
||||
| Nothing <- mbAlloc
|
||||
, any (is _Just) applicationAllocs
|
||||
= (</>) . unpack $ mr MsgCourseApplicationsNotAllocatedDirectory
|
||||
| otherwise
|
||||
= id
|
||||
|
||||
forM_ apps' $ \(mbAlloc, Entity _ User{..}, Entity appId CourseApplication{..}) -> do
|
||||
cID <- encrypt appId :: _ CryptoFileNameCourseApplication
|
||||
let mkAppDir = mkAllocationDir (entityVal <$> mbAlloc) . (</>) (unpack [st|#{CI.foldedCase $ ciphertext cID}-#{CI.foldCase userSurname}|])
|
||||
fileEntitySource = E.selectSource . E.from $ \courseApplicationFile -> do
|
||||
E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. E.val appId
|
||||
return courseApplicationFile
|
||||
|
||||
yield $ _FileReference # ( FileReference
|
||||
{ fileReferenceModified = courseApplicationTime
|
||||
, fileReferenceTitle = mkAppDir ""
|
||||
, fileReferenceContent = Nothing
|
||||
}
|
||||
, CourseApplicationFileResidual appId
|
||||
)
|
||||
|
||||
fileEntitySource .| C.map (view _entityVal) .| C.map (over (_FileReference . _1 . _fileReferenceTitle) mkAppDir)
|
||||
|
||||
|
||||
serveSomeFiles archiveName fsSource
|
||||
@ -1,636 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
-- TODO: probably remove applications in general
|
||||
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
|
||||
|
||||
module Handler.Course.Application.List
|
||||
( getCApplicationsR, postCApplicationsR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
import Database.Esqueleto.Utils.TH
|
||||
|
||||
import qualified Data.Csv as Csv
|
||||
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Lens as Text
|
||||
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
-- import Handler.Course.ParticipantInvite
|
||||
import Handler.Utils.StudyFeatures
|
||||
|
||||
-- import Jobs.Queue
|
||||
|
||||
|
||||
type CourseApplicationsTableExpr = ( E.SqlExpr (Entity CourseApplication)
|
||||
`E.InnerJoin` E.SqlExpr (Entity User)
|
||||
)
|
||||
`E.LeftOuterJoin` E.SqlExpr (Maybe (Entity Allocation))
|
||||
`E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseParticipant))
|
||||
type CourseApplicationsTableData = DBRow ( Entity CourseApplication
|
||||
, Entity User
|
||||
, Bool -- hasFiles
|
||||
, Maybe (Entity Allocation)
|
||||
, Bool -- isParticipant
|
||||
, UserTableStudyFeatures
|
||||
, Bool -- hasAllocationUser
|
||||
)
|
||||
|
||||
courseApplicationsIdent :: Text
|
||||
courseApplicationsIdent = "applications"
|
||||
|
||||
queryCourseApplication :: Getter CourseApplicationsTableExpr (E.SqlExpr (Entity CourseApplication))
|
||||
queryCourseApplication = to $ $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)
|
||||
|
||||
queryUser :: Getter CourseApplicationsTableExpr (E.SqlExpr (Entity User))
|
||||
queryUser = to $ $(sqlIJproj 2 2) . $(sqlLOJproj 3 1)
|
||||
|
||||
queryHasFiles :: Getter CourseApplicationsTableExpr (E.SqlExpr (E.Value Bool))
|
||||
queryHasFiles = to $ hasFiles . $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)
|
||||
where
|
||||
hasFiles appl = E.exists . E.from $ \courseApplicationFile ->
|
||||
E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. appl E.^. CourseApplicationId
|
||||
|
||||
queryAllocation :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity Allocation)))
|
||||
queryAllocation = to $(sqlLOJproj 3 2)
|
||||
|
||||
queryHasAllocationUser :: Getter CourseApplicationsTableExpr (E.SqlExpr (E.Value Bool))
|
||||
queryHasAllocationUser = to hasAllocationUser
|
||||
where
|
||||
hasAllocationUser (view queryCourseApplication -> courseApplication) = E.exists . E.from $ \allocationUser ->
|
||||
E.where_ $ E.just (allocationUser E.^. AllocationUserAllocation) E.==. courseApplication E.^. CourseApplicationAllocation
|
||||
E.&&. allocationUser E.^. AllocationUserUser E.==. courseApplication E.^. CourseApplicationUser
|
||||
|
||||
queryCourseParticipant :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity CourseParticipant)))
|
||||
queryCourseParticipant = to $(sqlLOJproj 3 3)
|
||||
|
||||
queryIsParticipant :: Getter CourseApplicationsTableExpr (E.SqlExpr (E.Value Bool))
|
||||
queryIsParticipant = to $ E.not_ . E.isNothing . (E.?. CourseParticipantId) . $(sqlLOJproj 3 3)
|
||||
|
||||
resultCourseApplication :: Lens' CourseApplicationsTableData (Entity CourseApplication)
|
||||
resultCourseApplication = _dbrOutput . _1
|
||||
|
||||
resultUser :: Lens' CourseApplicationsTableData (Entity User)
|
||||
resultUser = _dbrOutput . _2
|
||||
|
||||
resultHasFiles :: Lens' CourseApplicationsTableData Bool
|
||||
resultHasFiles = _dbrOutput . _3
|
||||
|
||||
resultAllocation :: Traversal' CourseApplicationsTableData (Entity Allocation)
|
||||
resultAllocation = _dbrOutput . _4 . _Just
|
||||
|
||||
resultIsParticipant :: Lens' CourseApplicationsTableData Bool
|
||||
resultIsParticipant = _dbrOutput . _5
|
||||
|
||||
resultStudyFeatures :: Lens' CourseApplicationsTableData UserTableStudyFeatures
|
||||
resultStudyFeatures = _dbrOutput . _6
|
||||
|
||||
resultHasAllocationUser :: Lens' CourseApplicationsTableData Bool
|
||||
resultHasAllocationUser = _dbrOutput . _7
|
||||
|
||||
|
||||
newtype CourseApplicationsTableVeto = CourseApplicationsTableVeto Bool
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
deriving newtype (Enum, Bounded)
|
||||
makePrisms ''CourseApplicationsTableVeto
|
||||
|
||||
instance Csv.ToField CourseApplicationsTableVeto where
|
||||
toField (CourseApplicationsTableVeto True) = "veto"
|
||||
toField (CourseApplicationsTableVeto False) = ""
|
||||
|
||||
instance Csv.FromField CourseApplicationsTableVeto where
|
||||
parseField f = do
|
||||
(CI.map Text.strip -> t :: CI Text) <- Csv.parseField f
|
||||
return . CourseApplicationsTableVeto $ elem t
|
||||
[ "veto", "v", "yes", "y", "ja", "j", "wahr", "w", "true", "t", "1" ]
|
||||
|
||||
data CourseApplicationsTableCsv = CourseApplicationsTableCsv
|
||||
{ csvCAAllocation :: Maybe AllocationShorthand
|
||||
, csvCAApplication :: Maybe CryptoFileNameCourseApplication
|
||||
, csvCAName :: Maybe Text
|
||||
, csvCAEmail :: Maybe UserEmail
|
||||
, csvCAMatriculation :: Maybe Text
|
||||
, csvCAStudyFeatures :: UserTableStudyFeatures
|
||||
, csvCAText :: Maybe Text
|
||||
, csvCAHasFiles :: Maybe Bool
|
||||
, csvCAVeto :: Maybe CourseApplicationsTableVeto
|
||||
, csvCARating :: Maybe ExamGrade
|
||||
, csvCAComment :: Maybe Text
|
||||
} deriving (Generic)
|
||||
makeLenses_ ''CourseApplicationsTableCsv
|
||||
|
||||
courseApplicationsTableCsvOptions :: Csv.Options
|
||||
courseApplicationsTableCsvOptions = Csv.defaultOptions { Csv.fieldLabelModifier = camelToPathPiece' 2 }
|
||||
|
||||
instance Csv.ToNamedRecord CourseApplicationsTableCsv where
|
||||
toNamedRecord = Csv.genericToNamedRecord courseApplicationsTableCsvOptions
|
||||
|
||||
instance Csv.FromNamedRecord CourseApplicationsTableCsv where
|
||||
parseNamedRecord csv
|
||||
= CourseApplicationsTableCsv
|
||||
<$> csv .:?? "allocation"
|
||||
<*> csv .:?? "application"
|
||||
<*> csv .:?? "name"
|
||||
<*> csv .:?? "email"
|
||||
<*> csv .:?? "matriculation"
|
||||
<*> pure mempty
|
||||
<*> csv .:?? "text"
|
||||
<*> csv .:?? "has-files"
|
||||
<*> csv .:?? "veto"
|
||||
<*> csv .:?? "rating"
|
||||
<*> csv .:?? "comment"
|
||||
|
||||
instance Csv.DefaultOrdered CourseApplicationsTableCsv where
|
||||
headerOrder = Csv.genericHeaderOrder courseApplicationsTableCsvOptions
|
||||
|
||||
instance CsvColumnsExplained CourseApplicationsTableCsv where
|
||||
csvColumnsExplanations = genericCsvColumnsExplanations courseApplicationsTableCsvOptions $ Map.fromList
|
||||
[ ('csvCAAllocation , MsgCsvColumnApplicationsAllocation )
|
||||
, ('csvCAApplication , MsgCsvColumnApplicationsApplication )
|
||||
, ('csvCAName , MsgCsvColumnApplicationsName )
|
||||
, ('csvCAEmail , MsgCsvColumnApplicationsEmail )
|
||||
, ('csvCAMatriculation, MsgCsvColumnApplicationsMatriculation)
|
||||
, ('csvCAStudyFeatures, MsgCsvColumnUserAppStudyFeatures )
|
||||
, ('csvCAText , MsgCsvColumnApplicationsText )
|
||||
, ('csvCAHasFiles , MsgCsvColumnApplicationsHasFiles )
|
||||
, ('csvCAVeto , MsgCsvColumnApplicationsVeto )
|
||||
, ('csvCARating , MsgCsvColumnApplicationsRating )
|
||||
, ('csvCAComment , MsgCsvColumnApplicationsComment )
|
||||
]
|
||||
|
||||
data CourseApplicationsTableCsvActionClass
|
||||
= CourseApplicationsTableCsvSetVeto
|
||||
| CourseApplicationsTableCsvSetRating
|
||||
| CourseApplicationsTableCsvSetComment
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
embedRenderMessage ''UniWorX ''CourseApplicationsTableCsvActionClass id
|
||||
|
||||
data CourseApplicationsTableCsvAction
|
||||
= CourseApplicationsTableCsvSetVetoData
|
||||
{ caCsvActApplication :: CourseApplicationId
|
||||
, caCsvActVeto :: Bool
|
||||
}
|
||||
| CourseApplicationsTableCsvSetRatingData
|
||||
{ caCsvActApplication :: CourseApplicationId
|
||||
, caCsvActRating :: Maybe ExamGrade
|
||||
}
|
||||
| CourseApplicationsTableCsvSetCommentData
|
||||
{ caCsvActApplication :: CourseApplicationId
|
||||
, caCsvActComment :: Maybe Text
|
||||
}
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
deriveJSON defaultOptions
|
||||
{ constructorTagModifier = over Text.packed $ Text.intercalate "-" . map Text.toLower . drop 4 . dropEnd 1 . splitCamel
|
||||
, fieldLabelModifier = camelToPathPiece' 3
|
||||
, sumEncoding = TaggedObject "action" "data"
|
||||
} ''CourseApplicationsTableCsvAction
|
||||
|
||||
data CourseApplicationsTableCsvException
|
||||
= CourseApplicationsTableCsvExceptionNoMatchingUser
|
||||
| CourseApplicationsTableCsvExceptionNoMatchingAllocation
|
||||
| CourseApplicationsTableCsvExceptionNoMatchingStudyFeatures
|
||||
deriving (Show, Generic, Typeable)
|
||||
|
||||
instance Exception CourseApplicationsTableCsvException
|
||||
|
||||
embedRenderMessage ''UniWorX ''CourseApplicationsTableCsvException id
|
||||
|
||||
|
||||
data ButtonAcceptApplications = BtnAcceptApplications
|
||||
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Universe ButtonAcceptApplications
|
||||
instance Finite ButtonAcceptApplications
|
||||
|
||||
nullaryPathPiece ''ButtonAcceptApplications $ camelToPathPiece' 1
|
||||
|
||||
embedRenderMessage ''UniWorX ''ButtonAcceptApplications id
|
||||
instance Button UniWorX ButtonAcceptApplications where
|
||||
btnClasses BtnAcceptApplications = [BCIsButton]
|
||||
|
||||
data AcceptApplicationsMode = AcceptApplicationsInvite
|
||||
| AcceptApplicationsDirect
|
||||
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Universe AcceptApplicationsMode
|
||||
instance Finite AcceptApplicationsMode
|
||||
|
||||
nullaryPathPiece ''AcceptApplicationsMode $ camelToPathPiece' 2
|
||||
|
||||
embedRenderMessage ''UniWorX ''AcceptApplicationsMode id
|
||||
|
||||
data AcceptApplicationsSecondary = AcceptApplicationsSecondaryRandom
|
||||
| AcceptApplicationsSecondaryTime
|
||||
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Universe AcceptApplicationsSecondary
|
||||
instance Finite AcceptApplicationsSecondary
|
||||
|
||||
nullaryPathPiece ''AcceptApplicationsSecondary $ camelToPathPiece' 3
|
||||
|
||||
embedRenderMessage ''UniWorX ''AcceptApplicationsSecondary id
|
||||
|
||||
|
||||
getCApplicationsR, postCApplicationsR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getCApplicationsR = postCApplicationsR
|
||||
postCApplicationsR tid ssh csh = do
|
||||
(table, allocationsBounds, mayAccept) <- runDB $ do
|
||||
now <- liftIO getCurrentTime
|
||||
Entity cid Course{..} <- getBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
|
||||
let
|
||||
allocationLink :: Allocation -> SomeRoute UniWorX
|
||||
allocationLink Allocation{..} = SomeRoute $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR
|
||||
|
||||
participantLink :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> m (SomeRoute UniWorX)
|
||||
participantLink uid = liftHandler $ do
|
||||
cID <- encrypt uid
|
||||
return . SomeRoute . CourseR tid ssh csh $ CUserR cID
|
||||
|
||||
applicationLink :: (MonadHandler m, HandlerSite m ~ UniWorX) => CourseApplicationId -> m (SomeRoute UniWorX)
|
||||
applicationLink appId = liftHandler $ do
|
||||
cID <- encrypt appId
|
||||
return . SomeRoute $ CApplicationR tid ssh csh cID CAEditR
|
||||
|
||||
dbtSQLQuery :: CourseApplicationsTableExpr -> E.SqlQuery _
|
||||
dbtSQLQuery = runReaderT $ do
|
||||
courseApplication <- view queryCourseApplication
|
||||
hasFiles <- view queryHasFiles
|
||||
user <- view queryUser
|
||||
allocation <- view queryAllocation
|
||||
courseParticipant <- view queryCourseParticipant
|
||||
hasAllocationUser <- view queryHasAllocationUser
|
||||
|
||||
lift $ do
|
||||
E.on $ E.just (user E.^. UserId) E.==. courseParticipant E.?. CourseParticipantUser
|
||||
E.&&. courseParticipant E.?. CourseParticipantCourse E.==. E.just (E.val cid)
|
||||
E.&&. courseParticipant E.?. CourseParticipantState E.==. E.just (E.val CourseParticipantActive)
|
||||
E.on $ courseApplication E.^. CourseApplicationAllocation E.==. allocation E.?. AllocationId
|
||||
E.on $ user E.^. UserId E.==. courseApplication E.^. CourseApplicationUser
|
||||
E.&&. courseApplication E.^. CourseApplicationCourse E.==. E.val cid
|
||||
|
||||
E.where_ $ E.maybe E.true (E.maybe E.false (E.<=. E.val now)) (allocation E.?. AllocationStaffAllocationFrom)
|
||||
|
||||
return ( courseApplication
|
||||
, user
|
||||
, hasFiles
|
||||
, allocation
|
||||
, E.not_ . E.isNothing $ courseParticipant E.?. CourseParticipantId
|
||||
, hasAllocationUser
|
||||
)
|
||||
|
||||
dbtProj :: _ CourseApplicationsTableData
|
||||
dbtProj = dbtProjSimple $ \(application, user, E.Value hasFiles, allocation, E.Value isParticipant, E.Value hasAllocationUser) -> do
|
||||
feats <- courseUserStudyFeatures (application ^. _entityVal . _courseApplicationCourse) (user ^. _entityKey)
|
||||
return (application, user, hasFiles, allocation, isParticipant, feats, hasAllocationUser)
|
||||
|
||||
dbtRowKey = view $ queryCourseApplication . to (E.^. CourseApplicationId)
|
||||
|
||||
dbtColonnade :: Cornice Sortable ('Cap 'Base) _ _
|
||||
dbtColonnade = mconcat
|
||||
[ cap (Sortable Nothing generatedColumnsHeader) $ mconcat
|
||||
[ sortable (Just "participant") (i18nCell MsgCourseApplicationIsParticipant) $ bool mempty (cell $ toWidget iconOK) . view resultIsParticipant
|
||||
, sortable (Just "allocation-short") (i18nCell MsgAllocation) $ \x ->
|
||||
let noAllocationUserShort alloc =
|
||||
[whamlet|
|
||||
$newline never
|
||||
<span .allocation--no-allocation-user>
|
||||
#{view _allocationShorthand alloc}
|
||||
|]
|
||||
noAllocationUserTooltip = messageTooltip =<< messageIconI Warning IconNoAllocationUser MsgApplicationAllocationNoAllocationUser
|
||||
in if | Just alloc <- x ^? resultAllocation . _entityVal
|
||||
, x ^. resultHasAllocationUser
|
||||
-> anchorCell (allocationLink alloc) $ alloc ^. _allocationShorthand
|
||||
| Just alloc <- x ^? resultAllocation . _entityVal
|
||||
-> anchorCell (allocationLink alloc) (noAllocationUserShort alloc)
|
||||
& cellContents . mapped %~ (<> noAllocationUserTooltip)
|
||||
| otherwise
|
||||
-> mempty
|
||||
, anchorColonnadeM (views (resultCourseApplication . _entityKey) applicationLink) $ colApplicationId (resultCourseApplication . _entityKey)
|
||||
, anchorColonnadeM (views (resultUser . _entityKey) participantLink) $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname)
|
||||
, lmap (view $ resultUser . _entityVal) colUserEmail
|
||||
, colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
|
||||
, colStudyFeatures resultStudyFeatures
|
||||
]
|
||||
, cap (Sortable Nothing $ i18nCell MsgApplicationUserColumns) $ mconcat
|
||||
[ colApplicationText (resultCourseApplication . _entityVal . _courseApplicationText)
|
||||
, lmap ((tid, ssh, csh), ) $ colApplicationFiles ($(multifocusG 5) (_1 . _1) (_1 . _2) (_1 . _3) (_2 . resultCourseApplication . _entityKey) (_2 . resultHasFiles))
|
||||
]
|
||||
, cap (Sortable Nothing $ i18nCell MsgApplicationRatingColumns) $ mconcat
|
||||
[ colApplicationVeto (resultCourseApplication . _entityVal . _courseApplicationRatingVeto)
|
||||
, colApplicationRatingPoints (resultCourseApplication . _entityVal . _courseApplicationRatingPoints)
|
||||
, colApplicationRatingComment (resultCourseApplication . _entityVal . _courseApplicationRatingComment)
|
||||
]
|
||||
]
|
||||
where generatedColumnsHeader = cell $ i18n MsgApplicationGeneratedColumns <> (messageTooltip =<< messageI Info MsgApplicationGeneratedColumnsTip)
|
||||
|
||||
dbtSorting = mconcat
|
||||
[ singletonMap "participant" . SortColumn $ view queryIsParticipant
|
||||
, sortAllocationShorthand $ queryAllocation . to (E.?. AllocationShorthand)
|
||||
, sortUserName' $ $(multifocusG 2) (queryUser . to (E.^. UserDisplayName)) (queryUser . to (E.^. UserSurname))
|
||||
, uncurry singletonMap . sortUserEmail $ view queryUser
|
||||
, sortUserMatriculation $ queryUser . to (E.^. UserMatrikelnummer)
|
||||
, sortApplicationText $ queryCourseApplication . to (E.^. CourseApplicationText)
|
||||
, sortApplicationFiles queryHasFiles
|
||||
, sortApplicationVeto $ queryCourseApplication . to (E.^. CourseApplicationRatingVeto)
|
||||
, sortApplicationRatingPoints $ queryCourseApplication . to (E.^. CourseApplicationRatingPoints)
|
||||
, sortApplicationRatingComment $ queryCourseApplication . to (E.^. CourseApplicationRatingComment)
|
||||
]
|
||||
|
||||
dbtFilter = mconcat
|
||||
[ fltrAllocation queryAllocation
|
||||
, fltrUserName' $ queryUser . to (E.^. UserDisplayName)
|
||||
, uncurry singletonMap . fltrUserEmail $ view queryUser
|
||||
, fltrUserMatriculation $ queryUser . to (E.^. UserMatrikelnummer)
|
||||
, fltrApplicationText $ queryCourseApplication . to (E.^. CourseApplicationText)
|
||||
, fltrApplicationFiles queryHasFiles
|
||||
, fltrApplicationVeto $ queryCourseApplication . to (E.^. CourseApplicationRatingVeto)
|
||||
, fltrApplicationRatingPoints $ queryCourseApplication . to (E.^. CourseApplicationRatingPoints)
|
||||
, fltrApplicationRatingComment $ queryCourseApplication . to (E.^. CourseApplicationRatingComment)
|
||||
, fltrRelevantStudyFeaturesTerms (to $
|
||||
\t -> ( E.val courseTerm
|
||||
, views queryUser (E.^. UserId) t
|
||||
))
|
||||
, fltrRelevantStudyFeaturesDegree (to $
|
||||
\t -> ( E.val courseTerm
|
||||
, views queryUser (E.^. UserId) t
|
||||
))
|
||||
, fltrRelevantStudyFeaturesSemester (to $
|
||||
\t -> ( E.val courseTerm
|
||||
, views queryUser (E.^. UserId) t
|
||||
))
|
||||
]
|
||||
dbtFilterUI = mconcat
|
||||
[ fltrAllocationUI
|
||||
, fltrUserNameUI'
|
||||
, fltrUserMatriculationUI
|
||||
, fltrUserEmailUI
|
||||
, fltrApplicationTextUI
|
||||
, fltrApplicationFilesUI
|
||||
, fltrApplicationVetoUI
|
||||
, fltrApplicationRatingPointsUI
|
||||
, fltrApplicationRatingCommentUI
|
||||
, fltrRelevantStudyFeaturesTermsUI
|
||||
, fltrRelevantStudyFeaturesDegreeUI
|
||||
, fltrRelevantStudyFeaturesSemesterUI
|
||||
]
|
||||
|
||||
dbtStyle = def
|
||||
{ dbsFilterLayout = defaultDBSFilterLayout
|
||||
}
|
||||
dbtParams = def
|
||||
|
||||
dbtCsvName = MsgCourseApplicationsTableCsvName tid ssh csh
|
||||
dbtCsvSheetName = MsgCourseApplicationsTableCsvSheetName tid ssh csh
|
||||
dbtCsvEncode = simpleCsvEncodeM dbtCsvName dbtCsvSheetName $ CourseApplicationsTableCsv
|
||||
<$> preview (resultAllocation . _entityVal . _allocationShorthand)
|
||||
<*> (preview (resultCourseApplication . _entityKey) >>= traverse encrypt)
|
||||
<*> preview (resultUser . _entityVal . _userDisplayName)
|
||||
<*> preview (resultUser . _entityVal . _userEmail)
|
||||
<*> preview (resultUser . _entityVal . _userMatrikelnummer . _Just)
|
||||
<*> view resultStudyFeatures
|
||||
<*> preview (resultCourseApplication . _entityVal . _courseApplicationText . _Just)
|
||||
<*> preview resultHasFiles
|
||||
<*> preview (resultCourseApplication . _entityVal . _courseApplicationRatingVeto . re _CourseApplicationsTableVeto)
|
||||
<*> preview (resultCourseApplication . _entityVal . _courseApplicationRatingPoints . _Just)
|
||||
<*> preview (resultCourseApplication . _entityVal . _courseApplicationRatingComment . _Just)
|
||||
dbtCsvDecode = Just DBTCsvDecode
|
||||
{ dbtCsvRowKey = \csv -> do
|
||||
appRes <- lift $ guessUser csv
|
||||
case appRes of
|
||||
Right appId -> return $ E.Value appId
|
||||
Left uid -> do
|
||||
alloc <- lift $ guessAllocation csv
|
||||
[appId] <- lift $ selectKeysList [CourseApplicationUser ==. uid, CourseApplicationAllocation ==. alloc] [LimitTo 2]
|
||||
return $ E.Value appId
|
||||
, dbtCsvComputeActions = \case
|
||||
DBCsvDiffMissing{}
|
||||
-> return () -- no deletion
|
||||
DBCsvDiffNew{}
|
||||
-> return () -- no addition
|
||||
DBCsvDiffExisting{..} -> do
|
||||
let appId = dbCsvOld ^. resultCourseApplication . _entityKey
|
||||
|
||||
let mVeto = dbCsvNew ^? _csvCAVeto . _Just . _CourseApplicationsTableVeto
|
||||
whenIsJust mVeto $ \veto ->
|
||||
when (veto /= dbCsvOld ^. resultCourseApplication . _entityVal . _courseApplicationRatingVeto) $
|
||||
yield $ CourseApplicationsTableCsvSetVetoData appId veto
|
||||
|
||||
when (dbCsvNew ^. _csvCARating /= dbCsvOld ^. resultCourseApplication . _entityVal . _courseApplicationRatingPoints) $
|
||||
yield $ CourseApplicationsTableCsvSetRatingData appId (dbCsvNew ^. _csvCARating)
|
||||
|
||||
when (dbCsvNew ^. _csvCAComment /= dbCsvOld ^. resultCourseApplication . _entityVal . _courseApplicationRatingComment) $
|
||||
yield $ CourseApplicationsTableCsvSetCommentData appId (dbCsvNew ^. _csvCAComment)
|
||||
, dbtCsvClassifyAction = \case
|
||||
CourseApplicationsTableCsvSetVetoData{} -> CourseApplicationsTableCsvSetVeto
|
||||
CourseApplicationsTableCsvSetRatingData{} -> CourseApplicationsTableCsvSetRating
|
||||
CourseApplicationsTableCsvSetCommentData{} -> CourseApplicationsTableCsvSetComment
|
||||
, dbtCsvCoarsenActionClass = const DBCsvActionExisting
|
||||
, dbtCsvValidateActions = return ()
|
||||
, dbtCsvExecuteActions = do
|
||||
C.mapM_ $ \case
|
||||
CourseApplicationsTableCsvSetVetoData{..} -> do
|
||||
CourseApplication{..} <- updateGet caCsvActApplication [ CourseApplicationRatingVeto =. caCsvActVeto
|
||||
, CourseApplicationRatingTime =. Just now
|
||||
]
|
||||
audit $ TransactionCourseApplicationEdit cid courseApplicationUser caCsvActApplication
|
||||
CourseApplicationsTableCsvSetRatingData{..} -> do
|
||||
CourseApplication{..} <- updateGet caCsvActApplication [ CourseApplicationRatingPoints =. caCsvActRating
|
||||
, CourseApplicationRatingTime =. Just now
|
||||
]
|
||||
audit $ TransactionCourseApplicationEdit cid courseApplicationUser caCsvActApplication
|
||||
CourseApplicationsTableCsvSetCommentData{..} -> do
|
||||
CourseApplication{..} <- updateGet caCsvActApplication [ CourseApplicationRatingComment =. caCsvActComment
|
||||
, CourseApplicationRatingTime =. Just now
|
||||
]
|
||||
audit $ TransactionCourseApplicationEdit cid courseApplicationUser caCsvActApplication
|
||||
return $ CourseR tid ssh csh CApplicationsR
|
||||
, dbtCsvRenderKey = \(existingApplicantName -> existingApplicantName') -> \case
|
||||
CourseApplicationsTableCsvSetVetoData{..} ->
|
||||
[whamlet|
|
||||
$newline never
|
||||
^{existingApplicantName' caCsvActApplication}
|
||||
$if caCsvActVeto
|
||||
, _{MsgCourseApplicationVeto}
|
||||
$else
|
||||
, _{MsgCourseApplicationNoVeto}
|
||||
|]
|
||||
CourseApplicationsTableCsvSetRatingData{..} ->
|
||||
[whamlet|
|
||||
$newline never
|
||||
^{existingApplicantName' caCsvActApplication}
|
||||
$maybe newResult <- caCsvActRating
|
||||
, _{newResult}
|
||||
$nothing
|
||||
, _{MsgCourseApplicationNoRatingPoints}
|
||||
|]
|
||||
CourseApplicationsTableCsvSetCommentData{..} ->
|
||||
[whamlet|
|
||||
$newline never
|
||||
^{existingApplicantName' caCsvActApplication}
|
||||
$if is _Nothing caCsvActComment
|
||||
, _{MsgCourseApplicationNoRatingComment}
|
||||
|]
|
||||
, dbtCsvRenderActionClass = toWidget <=< ap getMessageRender . pure
|
||||
, dbtCsvRenderException = ap getMessageRender . pure :: CourseApplicationsTableCsvException -> DB Text
|
||||
}
|
||||
where
|
||||
guessUser :: CourseApplicationsTableCsv -> DB (Either UserId CourseApplicationId)
|
||||
guessUser csv = do
|
||||
mApp <- runMaybeT $ do
|
||||
appId <- squash . catchIfMaybeT (const True :: CryptoIDError -> Bool) . MaybeT . traverse decrypt $ csv ^? _csvCAApplication . _Just
|
||||
CourseApplication{..} <- MaybeT $ get appId
|
||||
guard $ courseApplicationCourse == cid
|
||||
return appId
|
||||
|
||||
maybe (Left <$> guessUser' csv) (return . Right) mApp
|
||||
where
|
||||
guessUser' :: CourseApplicationsTableCsv -> DB UserId
|
||||
guessUser' CourseApplicationsTableCsv{..} = $cachedHereBinary (csvCAMatriculation, csvCAName) $ do
|
||||
users <- E.select . E.from $ \user -> do
|
||||
E.where_ . E.and $ catMaybes
|
||||
[ (user E.^. UserMatrikelnummer E.==.) . E.val . Just <$> csvCAMatriculation
|
||||
, (user E.^. UserEmail E.==.) . E.val <$> csvCAEmail
|
||||
, (user E.^. UserDisplayName E.==.) . E.val <$> csvCAName
|
||||
]
|
||||
return $ user E.^. UserId
|
||||
case users of
|
||||
[E.Value uid]
|
||||
-> return uid
|
||||
_other
|
||||
-> throwM CourseApplicationsTableCsvExceptionNoMatchingUser
|
||||
|
||||
guessAllocation :: CourseApplicationsTableCsv -> DB (Maybe AllocationId)
|
||||
guessAllocation CourseApplicationsTableCsv{..} = $cachedHereBinary csvCAAllocation . for csvCAAllocation $ \ash -> do
|
||||
mAlloc <- traverse (getJustEntity . allocationCourseAllocation . entityVal) <=< getBy $ UniqueAllocationCourse cid
|
||||
case mAlloc of
|
||||
Just (Entity allocId Allocation{..})
|
||||
| allocationShorthand == ash
|
||||
-> return allocId
|
||||
_other
|
||||
-> throwM CourseApplicationsTableCsvExceptionNoMatchingAllocation
|
||||
|
||||
existingApplicantName :: Map (E.Value CourseApplicationId) CourseApplicationsTableData -> CourseApplicationId -> Widget
|
||||
existingApplicantName existing (E.Value -> appId) = nameWidget userDisplayName userSurname
|
||||
where
|
||||
Entity _ User{..} = existing ^. singular (ix appId . resultUser)
|
||||
|
||||
dbtExtraReps = []
|
||||
|
||||
dbtIdent = courseApplicationsIdent
|
||||
|
||||
psValidator :: PSValidator _ _
|
||||
psValidator = def
|
||||
& defaultSorting [SortAscBy "user-name"]
|
||||
|
||||
participants <- count [ CourseParticipantCourse ==. cid, CourseParticipantState ==. CourseParticipantActive ]
|
||||
let remainingCapacity = subtract participants <$> courseCapacity
|
||||
|
||||
allocationsBounds' <- E.select . E.from $ \(allocation `E.InnerJoin` allocationCourse) -> do
|
||||
E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
|
||||
E.&&. allocationCourse E.^. AllocationCourseCourse E.==. E.val cid
|
||||
|
||||
let numApps addWhere = E.subSelectCount . E.from $ \courseApplication -> do
|
||||
E.where_ $ courseApplication E.^. CourseApplicationCourse E.==. E.val cid
|
||||
E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
|
||||
addWhere courseApplication
|
||||
|
||||
numApps' = numApps . const $ return ()
|
||||
|
||||
numFirstChoice = numApps $ \courseApplication ->
|
||||
E.where_ . E.not_ . E.exists . E.from $ \courseApplication' -> do
|
||||
E.where_ $ courseApplication E.^. CourseApplicationAllocation E.==. courseApplication' E.^. CourseApplicationAllocation
|
||||
E.&&. courseApplication E.^. CourseApplicationUser E.==. courseApplication' E.^. CourseApplicationUser
|
||||
E.where_ . E.not_ $ E.isNothing (courseApplication E.^. CourseApplicationAllocationPriority)
|
||||
E.||. E.isNothing (courseApplication' E.^. CourseApplicationAllocationPriority)
|
||||
E.where_ $ courseApplication' E.^. CourseApplicationAllocationPriority E.>. courseApplication E.^. CourseApplicationAllocationPriority
|
||||
|
||||
return (allocation, numApps', numFirstChoice)
|
||||
|
||||
let
|
||||
allocationsBounds = [ (allocation, numApps', numFirstChoice', capped)
|
||||
| (Entity _ allocation, E.Value numApps, E.Value numFirstChoice) <- allocationsBounds'
|
||||
, let numApps' = max 0 $ maybe id min remainingCapacity numApps
|
||||
numFirstChoice' = max 0 $ maybe id min remainingCapacity numFirstChoice
|
||||
capped = numApps' /= numApps
|
||||
|| numFirstChoice' /= numFirstChoice
|
||||
]
|
||||
|
||||
mayAccept <- hasWriteAccessTo $ CourseR tid ssh csh CAddUserR
|
||||
|
||||
(, allocationsBounds, mayAccept) <$> dbTableWidget' psValidator DBTable{..}
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
let title = prependCourseTitle tid ssh csh MsgCourseApplicationsListTitle
|
||||
registrationOpen = maybe True (now <)
|
||||
|
||||
|
||||
((_acceptRes, acceptWgt'), acceptEnc) <- runFormPost . identifyForm BtnAcceptApplications . renderAForm FormStandard $
|
||||
(,) <$> apopt (selectField optionsFinite) (fslI MsgAcceptApplicationsMode & setTooltip MsgAcceptApplicationsModeTip) (Just AcceptApplicationsInvite)
|
||||
<*> apopt (selectField optionsFinite) (fslI MsgAcceptApplicationsSecondary & setTooltip MsgAcceptApplicationsSecondaryTip) (Just AcceptApplicationsSecondaryTime)
|
||||
|
||||
let acceptWgt = wrapForm' BtnAcceptApplications acceptWgt' def
|
||||
{ formSubmit = FormSubmit
|
||||
, formAction = Just . SomeRoute $ CourseR tid ssh csh CApplicationsR
|
||||
, formEncoding = acceptEnc
|
||||
}
|
||||
|
||||
-- when mayAccept $
|
||||
-- formResult acceptRes $ \(invMode, appsSecOrder) -> do
|
||||
-- runDBJobs $ do
|
||||
-- -- Entity cid Course{..} <- getBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
-- -- participants <- count [ CourseParticipantCourse ==. cid, CourseParticipantState ==. CourseParticipantActive ]
|
||||
-- -- let openCapacity = subtract participants <$> courseCapacity
|
||||
|
||||
-- -- applications <- E.select . E.from $ \(user `E.InnerJoin` application) -> do
|
||||
-- -- E.on $ user E.^. UserId E.==. application E.^. CourseApplicationUser
|
||||
|
||||
-- -- E.where_ $ application E.^. CourseApplicationCourse E.==. E.val cid
|
||||
-- -- E.&&. E.isNothing (application E.^. CourseApplicationAllocation)
|
||||
-- -- E.&&. E.not_ (application E.^. CourseApplicationRatingVeto)
|
||||
-- -- E.&&. E.maybe E.true (`E.in_` E.valList (filter (view $ passingGrade . _Wrapped) universeF)) (application E.^. CourseApplicationRatingPoints )
|
||||
|
||||
-- -- E.where_ . E.not_ . E.exists . E.from $ \participant ->
|
||||
-- -- E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
|
||||
-- -- E.&&. participant E.^. CourseParticipantUser E.==. user E.^. UserId
|
||||
-- -- E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
|
||||
-- -- return (user, application)
|
||||
|
||||
-- -- let
|
||||
-- -- ratingL = _2 . _entityVal . _courseApplicationRatingPoints . to (Down . ExamGradeDefCenter)
|
||||
-- -- cmp = case appsSecOrder of
|
||||
-- -- AcceptApplicationsSecondaryTime
|
||||
-- -- -> comparing . view $ $(multifocusG 2) ratingL (_2 . _entityVal . _courseApplicationTime)
|
||||
-- -- AcceptApplicationsSecondaryRandom
|
||||
-- -- -> comparing $ view ratingL
|
||||
-- -- sortedApplications <- unstableSortBy cmp applications
|
||||
|
||||
-- -- let applicants = sortedApplications
|
||||
-- -- & nubOrdOn (view $ _1 . _entityKey)
|
||||
-- -- & maybe id take openCapacity
|
||||
-- -- & setOf (case invMode of
|
||||
-- -- AcceptApplicationsDirect -> folded . _1 . _entityKey . to Right
|
||||
-- -- AcceptApplicationsInvite -> folded . _1 . _entityVal . _userEmail . to Left
|
||||
-- -- )
|
||||
|
||||
-- -- mapM_ addMessage' <=< execWriterT $ registerUsers cid applicants
|
||||
-- redirect $ CourseR tid ssh csh CUsersR
|
||||
|
||||
let
|
||||
studyFeaturesWarning = $(i18nWidgetFile "applications-list-info")
|
||||
|
||||
siteLayoutMsg title $ do
|
||||
setTitleI title
|
||||
$(widgetFile "course/applications-list")
|
||||
@ -99,19 +99,7 @@ postCCommR tid ssh csh = do
|
||||
E.&&. user E.^. UserId E.==. corrector E.^. SheetCorrectorUser
|
||||
return user
|
||||
)
|
||||
] ++ tuts ++ exams ++ sheets ++
|
||||
[ ( RGCourseUnacceptedApplicants
|
||||
, E.from $ \user -> do
|
||||
E.where_ . E.exists . E.from $ \courseApplication ->
|
||||
E.where_ $ courseApplication E.^. CourseApplicationCourse E.==. E.val cid
|
||||
E.&&. courseApplication E.^. CourseApplicationUser E.==. user E.^. UserId
|
||||
E.where_ . E.not_ . E.exists . E.from $ \courseParticipant ->
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val cid
|
||||
E.&&. courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId
|
||||
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
return user
|
||||
)
|
||||
]
|
||||
] ++ tuts ++ exams ++ sheets
|
||||
, crRecipientAuth = Just $ \uid -> do
|
||||
cID <- encrypt uid
|
||||
evalAccessDB (CourseR tid ssh csh $ CUserR cID) False
|
||||
|
||||
@ -23,14 +23,11 @@ import qualified Data.Map as Map
|
||||
import qualified Control.Monad.State.Class as State
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import Jobs.Queue
|
||||
|
||||
import Handler.Course.LecturerInvite
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
|
||||
data CourseForm = CourseForm
|
||||
{ cfCourseId :: Maybe CourseId
|
||||
@ -43,13 +40,6 @@ data CourseForm = CourseForm
|
||||
, cfVisFrom :: Maybe UTCTime
|
||||
, cfVisTo :: Maybe UTCTime
|
||||
, cfMatFree :: Bool
|
||||
, cfAllocation :: Maybe AllocationCourseForm
|
||||
, cfAppRequired :: Bool
|
||||
, cfAppInstructions :: Maybe StoredMarkup
|
||||
, cfAppInstructionFiles :: Maybe FileUploads
|
||||
, cfAppText :: Bool
|
||||
, cfAppFiles :: UploadMode
|
||||
, cfAppRatingsVisible :: Bool
|
||||
, cfCapacity :: Maybe Int
|
||||
, cfSecret :: Maybe Text
|
||||
, cfRegFrom :: Maybe UTCTime
|
||||
@ -58,18 +48,10 @@ data CourseForm = CourseForm
|
||||
, cfLecturers :: [Either (UserEmail, Maybe LecturerType) (UserId, LecturerType)]
|
||||
}
|
||||
|
||||
data AllocationCourseForm = AllocationCourseForm
|
||||
{ acfAllocation :: AllocationId
|
||||
, acfMinCapacity :: Int
|
||||
, acfAcceptSubstitutes :: Maybe UTCTime
|
||||
, acfDeregisterNoShow :: Bool
|
||||
}
|
||||
|
||||
makeLenses_ ''CourseForm
|
||||
makeLenses_ ''AllocationCourseForm
|
||||
|
||||
courseToForm :: Entity Course -> [Lecturer] -> Map UserEmail (InvitationDBData Lecturer) -> Maybe (Entity AllocationCourse) -> CourseForm
|
||||
courseToForm cEnt@(Entity cid Course{..}) lecs lecInvites alloc = CourseForm
|
||||
courseToForm :: Entity Course -> [Lecturer] -> Map UserEmail (InvitationDBData Lecturer) -> CourseForm
|
||||
courseToForm (Entity cid Course{..}) lecs lecInvites = CourseForm
|
||||
{ cfCourseId = Just cid
|
||||
, cfName = courseName
|
||||
, cfDesc = courseDescription
|
||||
@ -80,13 +62,6 @@ courseToForm cEnt@(Entity cid Course{..}) lecs lecInvites alloc = CourseForm
|
||||
, cfCapacity = courseCapacity
|
||||
, cfSecret = courseRegisterSecret
|
||||
, cfMatFree = courseMaterialFree
|
||||
, cfAllocation = allocationCourseToForm cEnt <$> alloc
|
||||
, cfAppRequired = courseApplicationsRequired
|
||||
, cfAppInstructions = courseApplicationsInstructions
|
||||
, cfAppInstructionFiles
|
||||
, cfAppText = courseApplicationsText
|
||||
, cfAppFiles = courseApplicationsFiles
|
||||
, cfAppRatingsVisible = courseApplicationsRatingsVisible
|
||||
, cfVisFrom = courseVisibleFrom
|
||||
, cfVisTo = courseVisibleTo
|
||||
, cfRegFrom = courseRegisterFrom
|
||||
@ -95,21 +70,8 @@ courseToForm cEnt@(Entity cid Course{..}) lecs lecInvites alloc = CourseForm
|
||||
, cfLecturers = [Right (lecturerUser, lecturerType) | Lecturer{..} <- lecs]
|
||||
++ [Left (email, mType) | (email, InvDBDataLecturer mType) <- Map.toList lecInvites ]
|
||||
}
|
||||
where
|
||||
cfAppInstructionFiles = Just . transPipe runDB $ selectAppFiles .| C.map (view $ _entityVal . _FileReference . _1)
|
||||
where selectAppFiles = E.selectSource . E.from $ \courseAppInstructionFile -> do
|
||||
E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. E.val cid
|
||||
return courseAppInstructionFile
|
||||
|
||||
|
||||
allocationCourseToForm :: Entity Course -> Entity AllocationCourse -> AllocationCourseForm
|
||||
allocationCourseToForm (Entity _ Course{..}) (Entity _ AllocationCourse{..}) = AllocationCourseForm
|
||||
{ acfAllocation = allocationCourseAllocation
|
||||
, acfMinCapacity = allocationCourseMinCapacity
|
||||
, acfAcceptSubstitutes = allocationCourseAcceptSubstitutes
|
||||
, acfDeregisterNoShow = courseDeregisterNoShow
|
||||
}
|
||||
|
||||
makeCourseForm :: (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)) -> Maybe CourseForm -> Form CourseForm
|
||||
makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB validateCourse $ \html -> do
|
||||
-- TODO: Refactor to avoid the four repeated calls to liftHandler and three runDBs
|
||||
@ -211,77 +173,6 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
|
||||
, Just . beforeMidnight . termEnd <$> mbLastTerm
|
||||
)
|
||||
|
||||
let
|
||||
allocationForm :: AForm Handler (Maybe AllocationCourseForm)
|
||||
allocationForm = wFormToAForm $ do
|
||||
muid <- maybeAuthId
|
||||
availableAllocations' <- liftHandler . runDB . E.select . E.from $ \(allocation `E.InnerJoin` term) -> do
|
||||
E.on $ allocation E.^. AllocationTerm E.==. term E.^. TermId
|
||||
|
||||
let alreadyParticipates = flip (maybe E.false) (template >>= cfCourseId) $ \cid ->
|
||||
E.exists . E.from $ \allocationCourse ->
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. E.val cid
|
||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. allocation E.^. AllocationId
|
||||
|
||||
E.where_ $ termIsActiveE (E.val now) (E.val muid) (term E.^. TermId)
|
||||
E.||. alreadyParticipates
|
||||
E.||. allocation E.^. AllocationSchool `E.in_` E.valList adminSchools
|
||||
return (allocation, alreadyParticipates)
|
||||
|
||||
let
|
||||
allocationEnabled :: Entity Allocation -> Bool
|
||||
allocationEnabled (Entity _ Allocation{..})
|
||||
= ( NTop allocationStaffRegisterFrom <= NTop (Just now)
|
||||
&& NTop (Just now) <= NTop allocationStaffRegisterTo
|
||||
) || allocationSchool `elem` adminSchools
|
||||
availableAllocations = availableAllocations' ^.. folded . filtered (allocationEnabled . view _1) . _1
|
||||
activeAllocations = availableAllocations' ^.. folded . filtered ((&&) <$> (not <$> allocationEnabled . view _1) <*> view (_2 . _Value)) . _1
|
||||
|
||||
mkAllocationOption :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX) => Entity Allocation -> m (Option AllocationId)
|
||||
mkAllocationOption (Entity aId Allocation{..}) = liftHandler $ do
|
||||
cID <- encrypt aId :: Handler CryptoUUIDAllocation
|
||||
return . Option (mr . MsgCourseAllocationOption (mr . ShortTermIdentifier $ unTermKey allocationTerm) $ CI.original allocationName) aId $ toPathPiece cID
|
||||
|
||||
currentAllocationAvailable = (\alloc -> any ((== alloc) . entityKey) availableAllocations) . acfAllocation <$> (template >>= cfAllocation)
|
||||
|
||||
case (currentAllocationAvailable, availableAllocations) of
|
||||
(Nothing, []) -> wforced (convertField (const Nothing) (const False) checkBoxField) (fslI MsgCourseAllocationParticipate & setTooltip MsgCourseNoAllocationsAvailable) Nothing
|
||||
_ -> do
|
||||
allocationOptions <- mkOptionList <$> mapM mkAllocationOption (availableAllocations ++ activeAllocations)
|
||||
|
||||
let
|
||||
explainedAllocationOptions = return allocationOptions `explainOptionList` \allocId -> hoistMaybe . listToMaybe $ do
|
||||
(Entity allocId' Allocation{..}, _) <- availableAllocations'
|
||||
guard $ allocId' == allocId
|
||||
toWidget <$> hoistMaybe allocationStaffDescription
|
||||
|
||||
doExplain = has (folded . _entityVal . _allocationStaffDescription . _Just) $ availableAllocations ++ activeAllocations
|
||||
allocField | doExplain = explainedSelectionField Nothing explainedAllocationOptions
|
||||
| otherwise = selectField' Nothing $ return allocationOptions
|
||||
|
||||
userAdmin = not $ null adminSchools
|
||||
mayChange = Just False /= fmap (|| userAdmin) currentAllocationAvailable
|
||||
|
||||
allocationForm' =
|
||||
let ainp :: Field Handler a -> FieldSettings UniWorX -> Maybe a -> AForm Handler a
|
||||
ainp
|
||||
| mayChange
|
||||
= apreq
|
||||
| otherwise
|
||||
= aforcedJust
|
||||
in AllocationCourseForm
|
||||
<$> ainp allocField (fslI MsgCourseAllocation) (fmap acfAllocation $ template >>= cfAllocation)
|
||||
<*> ainp (natFieldI MsgCourseAllocationMinCapacityMustBeNonNegative) (fslI MsgCourseAllocationMinCapacity & setTooltip MsgCourseAllocationMinCapacityTip) (fmap acfMinCapacity $ template >>= cfAllocation)
|
||||
<*> aopt utcTimeField (fslI MsgCourseAcceptSubstitutesUntil & setTooltip MsgCourseAcceptSubstitutesUntilTip) (fmap acfAcceptSubstitutes $ template >>= cfAllocation)
|
||||
<*> apopt checkBoxField (fslI MsgCourseDeregisterNoShow & setTooltip MsgCourseDeregisterNoShowTip) ((<|> Just True) . fmap acfDeregisterNoShow $ template >>= cfAllocation)
|
||||
|
||||
let
|
||||
addTip :: (MonadHandler m, HandlerSite m ~ UniWorX)
|
||||
=> FieldView UniWorX -> m (FieldView UniWorX)
|
||||
addTip = addFieldViewTooltipWidget $(i18nWidgetFile "allocation-participate-tip")
|
||||
|
||||
hoist (censorM $ traverseOf _head addTip) $ optionalActionW' (bool mforcedJust mpopt mayChange) allocationForm' (fslI MsgCourseAllocationParticipate) (is _Just . cfAllocation <$> template)
|
||||
|
||||
multipleSchoolsMsg <- messageI Warning MsgCourseSchoolMultipleTip
|
||||
multipleTermsMsg <- messageI Warning MsgCourseSemesterMultipleTip
|
||||
|
||||
@ -305,13 +196,6 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
|
||||
& setTooltip MsgCourseVisibleToTip) (cfVisTo <$> template)
|
||||
<*> apopt checkBoxField (fslI MsgCourseMaterialFree) (cfMatFree <$> template)
|
||||
<* aformSection MsgCourseFormSectionRegistration
|
||||
<*> allocationForm
|
||||
<*> apopt checkBoxField (fslI MsgCourseApplicationRequired & setTooltip MsgCourseApplicationRequiredTip) (cfAppRequired <$> template)
|
||||
<*> aopt htmlField (fslI MsgCourseApplicationInstructions & setTooltip MsgCourseApplicationInstructionsTip) (cfAppInstructions <$> template)
|
||||
<*> aopt (multiFileField' . maybeVoid $ cfAppInstructionFiles =<< template) (fslI MsgCourseApplicationTemplate & setTooltip MsgCourseApplicationTemplateTip) (cfAppInstructionFiles <$> template)
|
||||
<*> apopt checkBoxField (fslI MsgCourseApplicationsText & setTooltip MsgCourseApplicationsTextTip) (cfAppText <$> template)
|
||||
<*> uploadModeForm (fslI MsgCourseApplicationsFiles & setTooltip MsgCourseApplicationsFilesTip) (fmap cfAppFiles template <|> pure NoUpload)
|
||||
<*> apopt checkBoxField (fslI MsgCourseApplicationRatingsVisible & setTooltip MsgCourseApplicationRatingsVisibleTip) (cfAppRatingsVisible <$> template)
|
||||
<*> aopt (natFieldI MsgCourseCapacity) (fslI MsgCourseCapacity
|
||||
& setTooltip MsgCourseCapacityTip) (cfCapacity <$> template)
|
||||
<*> aopt (textField & cfStrip) (fslpI MsgCourseSecret (mr MsgCourseSecretFormat)
|
||||
@ -331,31 +215,8 @@ validateCourse :: FormValidator CourseForm (YesodDB UniWorX) ()
|
||||
validateCourse = do
|
||||
CourseForm{..} <- State.get
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
uid <- liftHandler requireAuthId
|
||||
userAdmin <- lift . hasWriteAccessTo $ SchoolR cfSchool SchoolEditR
|
||||
newAllocationTerm <- for (acfAllocation <$> cfAllocation) $ lift . fmap allocationTerm . getJust
|
||||
|
||||
prevAllocationCourse <- join <$> traverse (lift . getBy . UniqueAllocationCourse) cfCourseId
|
||||
prevAllocation <- fmap join . traverse (lift . getEntity) $ allocationCourseAllocation . entityVal <$> prevAllocationCourse
|
||||
|
||||
oldAllocatedCapacity <- if
|
||||
| Just (Entity _ Allocation{..}) <- prevAllocation
|
||||
, Just (Entity _ AllocationCourse{..}) <- prevAllocationCourse
|
||||
, NTop allocationStaffAllocationTo <= NTop (Just now)
|
||||
, NTop allocationRegisterByCourse > NTop (Just now)
|
||||
-> lift $ Just . courseCapacity <$> getJust allocationCourseCourse
|
||||
| otherwise
|
||||
-> return Nothing
|
||||
let oldAllocation = do
|
||||
Entity allocId Allocation{..} <- prevAllocation
|
||||
guard $ NTop (Just now) > NTop allocationStaffRegisterTo
|
||||
pure $ Just allocId
|
||||
oldAllocatedMinCapacity = do
|
||||
Entity _ Allocation{..} <- prevAllocation
|
||||
Entity _ AllocationCourse{..} <- prevAllocationCourse
|
||||
guard $ NTop (Just now) > NTop allocationStaffRegisterTo
|
||||
pure $ Just allocationCourseMinCapacity
|
||||
|
||||
guardValidation MsgCourseVisibilityEndMustBeAfterStart
|
||||
$ NTop cfVisFrom <= NTop cfVisTo
|
||||
@ -363,29 +224,15 @@ validateCourse = do
|
||||
$ NTop cfRegFrom <= NTop cfRegTo
|
||||
guardValidation MsgCourseDeregistrationEndMustBeAfterStart
|
||||
$ Just False /= ((<=) <$> cfRegFrom <*> cfDeRegUntil)
|
||||
guardValidation MsgCourseAllocationRequiresCapacity
|
||||
$ is _Nothing cfAllocation || is _Just cfCapacity
|
||||
guardValidation MsgCourseAllocationTermMustMatch
|
||||
$ maybe True (== cfTerm) newAllocationTerm
|
||||
unless userAdmin $ do
|
||||
guardValidation MsgCourseUserMustBeLecturer
|
||||
$ anyOf (traverse . _Right . _1) (== uid) cfLecturers
|
||||
guardValidation MsgCourseAllocationCapacityMayNotBeChanged
|
||||
$ maybe True (== cfCapacity) oldAllocatedCapacity
|
||||
guardValidation MsgAllocationStaffRegisterToExpiredAllocation
|
||||
$ maybe True (== fmap acfAllocation cfAllocation) oldAllocation
|
||||
guardValidation MsgAllocationStaffRegisterToExpiredMinCapacity
|
||||
$ maybe True (== fmap acfMinCapacity cfAllocation) oldAllocatedMinCapacity
|
||||
|
||||
warnValidation MsgCourseShorthandTooLong
|
||||
$ length (CI.original cfShort) <= 10
|
||||
warnValidation MsgCourseNotAlwaysVisibleDuringRegistration
|
||||
$ NTop cfVisFrom <= NTop cfRegFrom && NTop cfRegTo <= NTop cfVisTo
|
||||
|
||||
warnValidation MsgCourseApplicationInstructionsRecommended
|
||||
$ (is _Just cfAppInstructions || is _Just cfAppInstructionFiles)
|
||||
|| not (cfAppText || isn't _NoUpload cfAppFiles)
|
||||
|
||||
|
||||
getCourseNewR :: Handler Html -- call via toTextUrl
|
||||
getCourseNewR = do
|
||||
@ -434,7 +281,7 @@ getCourseNewR = do
|
||||
return course
|
||||
template <- case listToMaybe oldCourses of
|
||||
(Just oldTemplate) ->
|
||||
let newTemplate = courseToForm oldTemplate mempty mempty Nothing in
|
||||
let newTemplate = courseToForm oldTemplate mempty mempty in
|
||||
return $ Just $ newTemplate
|
||||
{ cfCourseId = Nothing
|
||||
, cfTerm = TermKey $ termFromRational 0 -- invalid, will be ignored; undefined won't work due to strictness
|
||||
@ -467,11 +314,10 @@ pgCEditR tid ssh csh = do
|
||||
mbCourse <- getBy (TermSchoolCourseShort tid ssh csh)
|
||||
mbLecs <- for mbCourse $ \course -> map entityVal <$> selectList [LecturerCourse ==. entityKey course] [Asc LecturerType]
|
||||
mbLecInvites <- for mbCourse $ sourceInvitationsF . entityKey
|
||||
mbAllocation <- for mbCourse $ \course -> getBy . UniqueAllocationCourse $ entityKey course
|
||||
return $ (,,,) <$> mbCourse <*> mbLecs <*> mbLecInvites <*> mbAllocation
|
||||
return $ (,,) <$> mbCourse <*> mbLecs <*> mbLecInvites
|
||||
-- IMPORTANT: both GET and POST Handler must use the same template,
|
||||
-- since an Edit is identified via CourseID, which is not embedded in the received form data for security reasons.
|
||||
courseEditHandler (\p -> Just . SomeRoute $ CourseR tid ssh csh CEditR :#: p) $ $(uncurryN 4) courseToForm <$> courseData
|
||||
courseEditHandler (\p -> Just . SomeRoute $ CourseR tid ssh csh CEditR :#: p) $ $(uncurryN 3) courseToForm <$> courseData
|
||||
|
||||
|
||||
-- | Course Creation and Editing
|
||||
@ -501,24 +347,17 @@ courseEditHandler miButtonAction mbCourseForm = do
|
||||
, courseCapacity = cfCapacity
|
||||
, courseRegisterSecret = cfSecret
|
||||
, courseMaterialFree = cfMatFree
|
||||
, courseApplicationsRequired = cfAppRequired
|
||||
, courseApplicationsInstructions = cfAppInstructions
|
||||
, courseApplicationsText = cfAppText
|
||||
, courseApplicationsFiles = cfAppFiles
|
||||
, courseApplicationsRatingsVisible = cfAppRatingsVisible
|
||||
, courseVisibleFrom = cfVisFrom
|
||||
, courseVisibleTo = cfVisTo
|
||||
, courseRegisterFrom = cfRegFrom
|
||||
, courseRegisterTo = cfRegTo
|
||||
, courseDeregisterUntil = cfDeRegUntil
|
||||
, courseDeregisterNoShow = maybe False acfDeregisterNoShow cfAllocation
|
||||
}
|
||||
whenIsJust insertOkay $ \cid -> do
|
||||
let (invites, adds) = partitionEithers $ cfLecturers res
|
||||
insertMany_ $ map (\(lid, lty) -> Lecturer lid cid lty) adds
|
||||
sinkInvitationsF lecturerInvitationConfig $ map (\(lEmail, mLty) -> (lEmail, cid, (InvDBDataLecturer mLty, InvTokenDataLecturer))) invites
|
||||
insert_ $ CourseEdit aid now cid
|
||||
upsertAllocationCourse cid $ cfAllocation res
|
||||
memcachedByInvalidate AuthCacheLecturerList $ Proxy @(Set UserId)
|
||||
return insertOkay
|
||||
case insertOkay of
|
||||
@ -552,17 +391,11 @@ courseEditHandler miButtonAction mbCourseForm = do
|
||||
, courseCapacity = cfCapacity
|
||||
, courseRegisterSecret = cfSecret
|
||||
, courseMaterialFree = cfMatFree
|
||||
, courseApplicationsRequired = cfAppRequired
|
||||
, courseApplicationsInstructions = cfAppInstructions
|
||||
, courseApplicationsText = cfAppText
|
||||
, courseApplicationsFiles = cfAppFiles
|
||||
, courseApplicationsRatingsVisible = cfAppRatingsVisible
|
||||
, courseVisibleFrom = cfVisFrom
|
||||
, courseVisibleTo = cfVisTo
|
||||
, courseRegisterFrom = cfRegFrom
|
||||
, courseRegisterTo = cfRegTo
|
||||
, courseDeregisterUntil = cfDeRegUntil
|
||||
, courseDeregisterNoShow = maybe False acfDeregisterNoShow cfAllocation
|
||||
}
|
||||
case updOkay of
|
||||
(Just _) -> addMessageI Warning (MsgCourseEditDupShort tid ssh csh) $> False
|
||||
@ -575,11 +408,6 @@ courseEditHandler miButtonAction mbCourseForm = do
|
||||
|
||||
insert_ $ CourseEdit aid now cid
|
||||
|
||||
let mkFilter CourseAppInstructionFileResidual{..} = [ CourseAppInstructionFileCourse ==. courseAppInstructionFileResidualCourse ]
|
||||
in void . replaceFileReferences mkFilter (CourseAppInstructionFileResidual cid) . sequence_ $ cfAppInstructionFiles res
|
||||
|
||||
upsertAllocationCourse cid $ cfAllocation res
|
||||
|
||||
memcachedByInvalidate AuthCacheLecturerList $ Proxy @(Set UserId)
|
||||
|
||||
addMessageI Success $ MsgCourseEditOk tid ssh csh
|
||||
@ -592,26 +420,3 @@ courseEditHandler miButtonAction mbCourseForm = do
|
||||
{ formAction = Just $ SomeRoute actionUrl
|
||||
, formEncoding = formEnctype
|
||||
}
|
||||
|
||||
upsertAllocationCourse :: CourseId -> Maybe AllocationCourseForm -> YesodJobDB UniWorX ()
|
||||
upsertAllocationCourse cid = \case
|
||||
Just AllocationCourseForm{..} -> do
|
||||
prevAllocationCourse <- getBy $ UniqueAllocationCourse cid
|
||||
|
||||
void $ upsert AllocationCourse
|
||||
{ allocationCourseAllocation = acfAllocation
|
||||
, allocationCourseCourse = cid
|
||||
, allocationCourseMinCapacity = acfMinCapacity
|
||||
, allocationCourseAcceptSubstitutes = acfAcceptSubstitutes
|
||||
, allocationCourseOverrideSumCapacity = Nothing
|
||||
}
|
||||
[ AllocationCourseAllocation =. acfAllocation
|
||||
, AllocationCourseCourse =. cid
|
||||
, AllocationCourseMinCapacity =. acfMinCapacity
|
||||
, AllocationCourseAcceptSubstitutes =. acfAcceptSubstitutes
|
||||
]
|
||||
|
||||
when (Just acfAllocation /= fmap (allocationCourseAllocation . entityVal) prevAllocationCourse) $
|
||||
queueDBJob . JobQueueNotification $ NotificationAllocationNewCourse acfAllocation cid
|
||||
Nothing ->
|
||||
deleteWhere [ AllocationCourseCourse ==. cid ]
|
||||
|
||||
@ -18,23 +18,17 @@ import Data.Maybe (fromJust)
|
||||
|
||||
import Utils.Course
|
||||
import Utils.Form
|
||||
-- import Utils.DB
|
||||
import Handler.Utils hiding (colSchoolShort)
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Set as Set
|
||||
|
||||
|
||||
type CourseTableData = DBRow
|
||||
( Entity Course
|
||||
, Bool -- isRegistered
|
||||
, Entity School
|
||||
, [Entity User]
|
||||
, Maybe (Entity Allocation)
|
||||
, Bool -- mayEditCourse
|
||||
)
|
||||
|
||||
@ -50,24 +44,17 @@ resultIsRegistered = _dbrOutput . _2
|
||||
resultLecturers :: Traversal' CourseTableData (Entity User)
|
||||
resultLecturers = _dbrOutput . _4 . traverse
|
||||
|
||||
resultAllocation :: Traversal' CourseTableData (Entity Allocation)
|
||||
resultAllocation = _dbrOutput . _5 . _Just
|
||||
|
||||
resultMayEditCourse :: Lens' CourseTableData Bool
|
||||
resultMayEditCourse = _dbrOutput . _6
|
||||
resultMayEditCourse = _dbrOutput . _5
|
||||
|
||||
|
||||
type CourseTableExpr = (E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity School))
|
||||
`E.LeftOuterJoin` E.SqlExpr (Maybe (Entity Allocation))
|
||||
|
||||
queryCourse :: IndexPreservingGetter CourseTableExpr (E.SqlExpr (Entity Course))
|
||||
queryCourse = to $ $(E.sqlIJproj 2 1) . $(E.sqlLOJproj 2 1)
|
||||
queryCourse = to $ $(E.sqlIJproj 2 1)
|
||||
|
||||
querySchool :: IndexPreservingGetter CourseTableExpr (E.SqlExpr (Entity School))
|
||||
querySchool = to $ $(E.sqlIJproj 2 2) . $(E.sqlLOJproj 2 1)
|
||||
|
||||
queryAllocation :: IndexPreservingGetter CourseTableExpr (E.SqlExpr (Maybe (Entity Allocation)))
|
||||
queryAllocation = to $(E.sqlLOJproj 2 2)
|
||||
querySchool = to $ $(E.sqlIJproj 2 2)
|
||||
|
||||
queryParticipants :: IndexPreservingGetter CourseTableExpr (E.SqlExpr (E.Value Int))
|
||||
queryParticipants = queryCourse . to (E.^. CourseId) . to numCourseParticipants
|
||||
@ -83,9 +70,7 @@ queryMayViewCourse :: Maybe UserId
|
||||
-> IndexPreservingGetter CourseTableExpr (E.SqlExpr (E.Value Bool))
|
||||
queryMayViewCourse muid ata now = to . runReader $ do
|
||||
course <- view queryCourse
|
||||
allocation <- view queryAllocation
|
||||
|
||||
return $ mayViewCourse muid ata now course (allocation E.?. AllocationId)
|
||||
return $ mayViewCourse muid ata now course
|
||||
|
||||
queryIsEditor :: Maybe UserId
|
||||
-> AuthTagActive
|
||||
@ -123,21 +108,6 @@ colRegistered :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a
|
||||
colRegistered = sortable (Just "registered") (i18nCell MsgFilterRegistered) $ views resultIsRegistered tickmarkCell
|
||||
|
||||
|
||||
data AllocationSearch
|
||||
= AllocationSearchNoAllocation
|
||||
| AllocationSearchMatch TermId SchoolId AllocationShorthand
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
|
||||
instance PathPiece AllocationSearch where
|
||||
toPathPiece AllocationSearchNoAllocation = "no-allocation"
|
||||
toPathPiece (AllocationSearchMatch tid ssh ash) = pathPieceJoined "-" # [toPathPiece tid, toPathPiece ssh, toPathPiece ash]
|
||||
fromPathPiece t
|
||||
| CI.mk (Text.strip t) == "no-allocation" = pure AllocationSearchNoAllocation
|
||||
| Just [tid, ssh, ash] <- t ^? pathPieceJoined "-"
|
||||
= AllocationSearchMatch <$> fromPathPiece tid <*> fromPathPiece ssh <*> fromPathPiece ash
|
||||
| otherwise = mzero
|
||||
|
||||
|
||||
makeCourseTable :: (ToSortable h, Functor h)
|
||||
=> Colonnade h CourseTableData (DBCell Handler ()) -> PSValidator Handler () -> DB Widget
|
||||
makeCourseTable colChoices psValidator' = do
|
||||
@ -148,45 +118,15 @@ makeCourseTable colChoices psValidator' = do
|
||||
now <- liftIO getCurrentTime
|
||||
ata <- getSessionActiveAuthTags
|
||||
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
let allocSearchNoAllocOption = Option
|
||||
{ optionDisplay = mr MsgFilterCourseAllocationNone
|
||||
, optionInternalValue
|
||||
, optionExternalValue = toPathPiece optionInternalValue
|
||||
}
|
||||
where optionInternalValue = AllocationSearchNoAllocation
|
||||
allocationSearchOptions <- mkOptionList . (allocSearchNoAllocOption :) <$> do
|
||||
allocs <- E.select . E.from $ \allocation -> do
|
||||
E.orderBy [ E.desc $ allocation E.^. AllocationTerm
|
||||
, E.asc $ allocation E.^. AllocationSchool
|
||||
, E.asc $ allocation E.^. AllocationName
|
||||
]
|
||||
return ( allocation E.^. AllocationTerm, allocation E.^. AllocationSchool, allocation E.^. AllocationShorthand
|
||||
, allocation E.^. AllocationName
|
||||
)
|
||||
return . flip map allocs $ \(E.Value tid, E.Value ssh, E.Value ash, E.Value aname)
|
||||
-> let optionInternalValue = AllocationSearchMatch tid ssh ash
|
||||
in Option
|
||||
{ optionDisplay = mr $ MsgFilterCourseAllocationOption tid ssh aname
|
||||
, optionInternalValue
|
||||
, optionExternalValue = toPathPiece optionInternalValue
|
||||
}
|
||||
|
||||
let dbtSQLQuery :: CourseTableExpr -> E.SqlQuery _
|
||||
dbtSQLQuery = runReaderT $ do
|
||||
course <- view queryCourse
|
||||
school <- view querySchool
|
||||
allocation <- view queryAllocation
|
||||
|
||||
lift . E.on . E.exists . E.from $ \allocationCourse ->
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.&&. allocation E.?. AllocationId E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
|
||||
lift . E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
|
||||
|
||||
registered <- view $ queryIsRegistered muid ata
|
||||
isEditor <- view $ queryIsEditor muid ata
|
||||
|
||||
return (course, registered, school, allocation, isEditor)
|
||||
return (course, registered, school, isEditor)
|
||||
lecturerQuery cid (user `E.InnerJoin` lecturer) = do
|
||||
E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
|
||||
E.where_ $ cid E.==. lecturer E.^. LecturerCourse
|
||||
@ -197,9 +137,9 @@ makeCourseTable colChoices psValidator' = do
|
||||
E.where_ $ cid E.==. lecturer E.^. LecturerCourse
|
||||
return user
|
||||
dbtProj :: _ CourseTableData
|
||||
dbtProj = dbtProjSimple $ \(course, E.Value registered, school, allocation, E.Value isEditor) -> do
|
||||
dbtProj = dbtProjSimple $ \(course, E.Value registered, school, E.Value isEditor) -> do
|
||||
lecturerList <- E.select $ E.from $ lecturerQuery $ E.val $ entityKey course
|
||||
return (course, registered, school, lecturerList, allocation, isEditor)
|
||||
return (course, registered, school, lecturerList, isEditor)
|
||||
|
||||
dbTableWidget' psValidator DBTable
|
||||
{ dbtSQLQuery
|
||||
@ -229,25 +169,13 @@ makeCourseTable colChoices psValidator' = do
|
||||
E.where_ $ user E.^. UserDisplayName `E.hasInfix` E.val c
|
||||
, singletonMap "openregistration" . FilterColumn . E.mkExactFilterLast . runReader $ do
|
||||
course <- view queryCourse
|
||||
allocation <- view queryAllocation
|
||||
|
||||
let regTo = course E.^. CourseRegisterTo
|
||||
regFrom = course E.^. CourseRegisterFrom
|
||||
courseOpen = E.maybe E.false (\f -> f E.<=. E.val now) regFrom
|
||||
E.&&. E.maybe E.true (\t -> E.val now E.<=. t) regTo
|
||||
allocOpen = ( E.maybe E.false (\f -> f E.<=. E.val now) (E.joinV $ allocation E.?. AllocationRegisterFrom)
|
||||
E.&&. E.maybe E.true (\t -> E.val now E.<=. t) (E.joinV $ allocation E.?. AllocationRegisterTo)
|
||||
)
|
||||
E.||. ( courseOpen
|
||||
E.&&. E.maybe E.false (\f -> f E.<=. E.val now) (E.joinV $ allocation E.?. AllocationRegisterByCourse)
|
||||
)
|
||||
|
||||
return $ ( courseOpen
|
||||
E.&&. E.isNothing (allocation E.?. AllocationId)
|
||||
)
|
||||
E.||. ( allocOpen
|
||||
E.&&. E.isJust (allocation E.?. AllocationId)
|
||||
)
|
||||
return courseOpen
|
||||
, singletonMap "registered" . FilterColumn . E.mkExactFilterLast . view $ queryIsRegistered muid ata
|
||||
, singletonMap "search" . FilterColumn $ \(view queryCourse -> course) criterion -> case getLast (criterion :: Last Text) of
|
||||
Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||
@ -260,14 +188,6 @@ makeCourseTable colChoices psValidator' = do
|
||||
, singletonMap "search-title" . FilterColumn $ \(view queryCourse -> course) criterion -> case getLast (criterion :: Last Text) of
|
||||
Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||
Just needle -> E.castString (course E.^. CourseName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)
|
||||
, singletonMap "allocation" . FilterColumn $ \row (criteria :: Set AllocationSearch) -> if
|
||||
| Set.null criteria -> E.true
|
||||
| otherwise -> flip E.any criteria $ \case
|
||||
AllocationSearchNoAllocation -> E.isNothing $ view queryAllocation row E.?. AllocationId
|
||||
AllocationSearchMatch tid ssh ash
|
||||
-> view queryAllocation row E.?. AllocationTerm E.==. E.justVal tid
|
||||
E.&&. view queryAllocation row E.?. AllocationSchool E.==. E.justVal ssh
|
||||
E.&&. view queryAllocation row E.?. AllocationShorthand E.==. E.justVal ash
|
||||
]
|
||||
, dbtFilterUI = \mPrev -> mconcat $ catMaybes
|
||||
[ pure $ prismAForm (singletonFilter "term" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift termField) (fslI MsgTableTerm)
|
||||
@ -279,11 +199,10 @@ makeCourseTable colChoices psValidator' = do
|
||||
, pure $ prismAForm (singletonFilter "openregistration" . maybePrism _PathPiece) mPrev $ fmap (\x -> if isJust x && not (fromJust x) then Nothing else x) . aopt checkBoxField (fslI MsgFilterCourseRegisterOpen)
|
||||
, guardOn (is _Just muid)
|
||||
$ prismAForm (singletonFilter "registered" . maybePrism _PathPiece) mPrev (aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterCourseRegistered))
|
||||
, pure $ prismAForm (singletonFilter "allocation" . maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgTableNoFilter) $ return allocationSearchOptions) (fslI MsgFilterCourseAllocation)
|
||||
]
|
||||
, dbtStyle = def
|
||||
{ dbsFilterLayout = defaultDBSFilterLayout
|
||||
, dbsTemplate = DBSTCourse resultCourse resultLecturers resultIsRegistered resultSchool resultAllocation resultMayEditCourse
|
||||
, dbsTemplate = DBSTCourse resultCourse resultLecturers resultIsRegistered resultSchool resultMayEditCourse
|
||||
}
|
||||
, dbtParams = def
|
||||
, dbtIdent = "courses" :: Text
|
||||
|
||||
@ -247,16 +247,14 @@ registerUser cid (_avsIdent, Just uid) = exceptT return return $ do
|
||||
CourseParticipant -- TODO: use participantId instead of userId for aurRegisterSuccess
|
||||
{ courseParticipantCourse = cid
|
||||
, courseParticipantUser = uid
|
||||
, courseParticipantAllocated = Nothing
|
||||
, courseParticipantState = CourseParticipantActive
|
||||
, ..
|
||||
}
|
||||
[ CourseParticipantRegistration =. courseParticipantRegistration
|
||||
, CourseParticipantAllocated =. Nothing
|
||||
, CourseParticipantState =. CourseParticipantActive
|
||||
]
|
||||
lift . audit $ TransactionCourseParticipantEdit cid uid
|
||||
lift . queueDBJob . JobQueueNotification $ NotificationCourseRegistered uid cid -- TODO: send Notification at all?
|
||||
lift . queueDBJob . JobQueueNotification $ NotificationCourseRegistered uid cid
|
||||
|
||||
return $ mempty { aurRegisterSuccess = Set.singleton uid }
|
||||
|
||||
@ -283,6 +281,7 @@ upsertNewTutorial cid tutorialName = do
|
||||
, TutorialType =. CI.mk "Schulung"
|
||||
, TutorialLastChanged =. now
|
||||
]
|
||||
-- TODO: audit
|
||||
return tutId
|
||||
|
||||
registerTutorialMembers :: TutorialId -> Set UserId -> Handler ()
|
||||
@ -291,6 +290,7 @@ registerTutorialMembers tutId (Set.toList -> users) = runDB $ do
|
||||
participants <- fmap Set.fromList . for users $ \tutorialParticipantUser -> upsert
|
||||
TutorialParticipant { tutorialParticipantTutorial = tutId, .. }
|
||||
[]
|
||||
-- TODO: audit
|
||||
let newParticipants = participants Set.\\ prevParticipants
|
||||
unless (Set.null newParticipants) $
|
||||
addMessageI Success . MsgCourseParticipantsRegisteredTutorial $ Set.size newParticipants
|
||||
|
||||
@ -17,17 +17,12 @@ import Handler.Utils.Exam
|
||||
|
||||
import Utils.Course
|
||||
|
||||
import qualified Data.Text as Text
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
import Database.Persist.Sql (transactionUndo)
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
|
||||
-- Dedicated CourseRegistrationButton
|
||||
data ButtonCourseRegister = BtnCourseRegister | BtnCourseDeregister | BtnCourseApply | BtnCourseRetractApplication
|
||||
data ButtonCourseRegister = BtnCourseRegister | BtnCourseDeregister
|
||||
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Universe ButtonCourseRegister
|
||||
instance Finite ButtonCourseRegister
|
||||
@ -36,19 +31,13 @@ embedRenderMessage ''UniWorX ''ButtonCourseRegister id
|
||||
instance Button UniWorX ButtonCourseRegister where
|
||||
btnClasses BtnCourseRegister = [BCIsButton, BCPrimary]
|
||||
btnClasses BtnCourseDeregister = [BCIsButton, BCDanger]
|
||||
btnClasses BtnCourseApply = [BCIsButton, BCPrimary]
|
||||
btnClasses BtnCourseRetractApplication = [BCIsButton, BCDanger]
|
||||
|
||||
btnLabel BtnCourseRegister = [whamlet|#{iconEnrol True} _{MsgBtnCourseRegister}|]
|
||||
btnLabel BtnCourseDeregister = [whamlet|#{iconEnrol False} _{MsgBtnCourseDeregister}|]
|
||||
btnLabel BtnCourseApply = [whamlet|#{iconApply True} _{MsgBtnCourseApply}|]
|
||||
btnLabel BtnCourseRetractApplication = [whamlet|#{iconApply False} _{MsgBtnCourseRetractApplication}|]
|
||||
|
||||
|
||||
data CourseRegisterForm = CourseRegisterForm
|
||||
{ crfApplicationText :: Maybe Text
|
||||
, crfApplicationFiles :: Maybe FileUploads
|
||||
}
|
||||
{}
|
||||
|
||||
courseRegisterForm :: (MonadHandler m, HandlerSite m ~ UniWorX) => Entity Course -> m (AForm Handler CourseRegisterForm, ButtonCourseRegister)
|
||||
-- ^ `CourseRegisterForm` for current user
|
||||
@ -57,20 +46,13 @@ courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
|
||||
ata <- getSessionActiveAuthTags
|
||||
now <- liftIO getCurrentTime
|
||||
|
||||
(registration, application) <- runDB $ do
|
||||
registration <- fmap join . for muid $ fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy . flip UniqueParticipant cid
|
||||
application <- fmap (listToMaybe =<<) . for muid $ \uid -> selectList [CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid, CourseApplicationAllocation ==. Nothing] []
|
||||
return (registration, application)
|
||||
let btn | courseApplicationsRequired
|
||||
, is _Just application
|
||||
= BtnCourseRetractApplication
|
||||
| is _Just registration
|
||||
registration <- runDB .
|
||||
fmap join . for muid $ fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy . flip UniqueParticipant cid
|
||||
let btn | is _Just registration
|
||||
= BtnCourseDeregister
|
||||
| courseApplicationsRequired
|
||||
= BtnCourseApply
|
||||
| otherwise
|
||||
= BtnCourseRegister
|
||||
isRegistered = btn `elem` [BtnCourseRetractApplication, BtnCourseDeregister]
|
||||
isRegistered = btn `elem` [BtnCourseDeregister]
|
||||
return . (, btn) . wFormToAForm $ do
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
|
||||
@ -86,71 +68,11 @@ courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
|
||||
| otherwise
|
||||
-> return $ FormSuccess ()
|
||||
|
||||
appTextRes <- let fs | courseApplicationsRequired
|
||||
, is _Just courseApplicationsInstructions
|
||||
= fslI MsgCourseApplicationText & setTooltip MsgCourseApplicationFollowInstructions
|
||||
| courseApplicationsRequired
|
||||
= fslI MsgCourseApplicationText
|
||||
| is _Just courseApplicationsInstructions
|
||||
= fslI MsgCourseRegistrationText & setTooltip MsgCourseRegistrationFollowInstructions
|
||||
| otherwise
|
||||
= fslI MsgCourseRegistrationText
|
||||
textField' = convertField unTextarea Textarea textareaField
|
||||
in if
|
||||
| not courseApplicationsText
|
||||
-> return $ FormSuccess Nothing
|
||||
| is _Just muid
|
||||
, isRegistered
|
||||
-> wforced (convertField Just (fromMaybe Text.empty) textField') fs (application >>= courseApplicationText . entityVal)
|
||||
| otherwise
|
||||
-> fmap (assertM (not . Text.null) . fmap Text.strip) <$> wopt textField' fs (Just $ application >>= courseApplicationText . entityVal)
|
||||
|
||||
appFilesInfo <- for application $ \(Entity appId _) -> liftHandler . runDB $ do
|
||||
hasFiles <- exists [ CourseApplicationFileApplication ==. appId ]
|
||||
appCID <- encrypt appId
|
||||
appFilesLink <- toTextUrl $ CApplicationR courseTerm courseSchool courseShorthand appCID CAFilesR
|
||||
return (hasFiles, appFilesLink)
|
||||
let hasFiles = maybe False (view _1) appFilesInfo
|
||||
filesMsg = bool MsgCourseRegistrationFiles MsgCourseApplicationFiles courseApplicationsRequired
|
||||
|
||||
when (isn't _NoUpload courseApplicationsFiles || hasFiles) $
|
||||
let filesLinkField = Field{..}
|
||||
where
|
||||
fieldParse _ _ = return $ Right Nothing
|
||||
fieldEnctype = mempty
|
||||
fieldView theId _ attrs _ _ =
|
||||
[whamlet|
|
||||
$newline never
|
||||
$case appFilesInfo
|
||||
$of Just (True, appFilesLink)
|
||||
<a ##{theId} *{attrs} href=#{appFilesLink}>
|
||||
_{filesMsg}
|
||||
$of _
|
||||
<span ##{theId} *{attrs}>
|
||||
_{MsgCourseApplicationNoFiles}
|
||||
|]
|
||||
in void $ wforced filesLinkField (fslI filesMsg) Nothing
|
||||
|
||||
when (hasFiles && isn't _NoUpload courseApplicationsFiles) $
|
||||
wformMessage <=< messageIconI Info IconFileUpload $ bool MsgCourseRegistrationFilesNeedReupload MsgCourseApplicationFilesNeedReupload courseApplicationsRequired
|
||||
|
||||
appFilesRes <- let mkFs | courseApplicationsRequired = bool MsgCourseApplicationFile MsgCourseApplicationArchive
|
||||
| otherwise = bool MsgCourseRegistrationFile MsgCourseRegistrationArchive
|
||||
prevAppFiles (Entity aId _) = runDBSource $ selectSource [CourseApplicationFileApplication ==. aId] [Asc CourseApplicationFileTitle] .| C.map (view $ _FileReference . _1)
|
||||
in if
|
||||
| isRegistered
|
||||
-> return $ FormSuccess Nothing
|
||||
| otherwise
|
||||
-> aFormToWForm $ fileUploadForm False (fslI . mkFs) courseApplicationsFiles (prevAppFiles <$> application)
|
||||
|
||||
mayViewCourseAfterDeregistration <- liftHandler . runDB $ E.selectExists . E.from $ \(course `E.LeftOuterJoin` allocation) -> do
|
||||
E.on . E.exists . E.from $ \allocationCourse ->
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.&&. E.just (allocationCourse E.^. AllocationCourseAllocation) E.==. allocation E.?. AllocationId
|
||||
mayViewCourseAfterDeregistration <- liftHandler . runDB $ E.selectExists . E.from $ \course -> do
|
||||
E.where_ $ course E.^. CourseId E.==. E.val cid
|
||||
E.&&. ( isSchoolAdminLike muid ata (course E.^. CourseSchool)
|
||||
E.||. mayEditCourse muid ata course
|
||||
E.||. courseIsVisible now course (allocation E.?. AllocationId)
|
||||
E.||. courseIsVisible now course
|
||||
E.||. isCourseLecturer muid ata (course E.^. CourseId)
|
||||
E.||. isCourseTutor muid ata (course E.^. CourseId)
|
||||
E.||. isCourseSheetCorrector muid ata (course E.^. CourseId)
|
||||
@ -159,19 +81,12 @@ courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
|
||||
|
||||
mayReRegister <- liftHandler . runDB . courseMayReRegister $ Entity cid Course{..}
|
||||
|
||||
when (is _Just $ registration >>= courseParticipantAllocated . entityVal) $
|
||||
wformMessage =<< messageIconI Warning IconExamRegisterFalse MsgCourseDeregistrationAllocationLog
|
||||
when (is _Just (registration >>= courseParticipantAllocated . entityVal) && courseDeregisterNoShow) $
|
||||
wformMessage =<< messageIconI Warning IconEnrolFalse MsgCourseDeregistrationNoShow
|
||||
when (isRegistered && not mayViewCourseAfterDeregistration) $
|
||||
wformMessage =<< messageIconI Warning IconEnrolFalse MsgCourseDeregistrationFromInvisibleCourse
|
||||
unless mayReRegister $
|
||||
wformMessage =<< messageIconI Warning IconEnrolFalse MsgCourseDeregistrationNoReRegistration
|
||||
|
||||
return $ CourseRegisterForm
|
||||
<$ secretRes
|
||||
<*> appTextRes
|
||||
<*> appFilesRes
|
||||
return $ CourseRegisterForm <$ secretRes
|
||||
|
||||
courseMayReRegister :: Entity Course -> DB Bool
|
||||
courseMayReRegister (Entity cid Course{..}) = do
|
||||
@ -200,101 +115,36 @@ postCRegisterR tid ssh csh = do
|
||||
course@(Entity cid Course{..}) <- runDB . getBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
(courseRegisterForm', courseRegisterButton) <- courseRegisterForm course
|
||||
((regResult,_), _) <- runFormPost $ renderAForm FormStandard courseRegisterForm'
|
||||
formResult regResult $ \CourseRegisterForm{..} -> do
|
||||
formResult regResult $ \CourseRegisterForm{} -> do
|
||||
cTime <- liftIO getCurrentTime
|
||||
let
|
||||
doApplication = courseApplicationsRequired || is _Just (void crfApplicationText <|> void crfApplicationFiles)
|
||||
mkApplication
|
||||
| doApplication
|
||||
= void <$> do
|
||||
appIds <- selectKeysList [ CourseApplicationAllocation ==. Nothing, CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid ] []
|
||||
appRes <- case appIds of
|
||||
[] -> insertUnique $ CourseApplication cid uid crfApplicationText False Nothing Nothing Nothing Nothing cTime Nothing
|
||||
(prevId:ps) -> do
|
||||
forM_ ps $ \appId -> do
|
||||
deleteApplicationFiles appId
|
||||
delete appId
|
||||
audit $ TransactionCourseApplicationDeleted cid uid appId
|
||||
|
||||
deleteApplicationFiles prevId
|
||||
update prevId [ CourseApplicationText =. crfApplicationText, CourseApplicationTime =. cTime ]
|
||||
|
||||
return $ Just prevId
|
||||
|
||||
whenIsJust appRes $
|
||||
audit . TransactionCourseApplicationEdit cid uid
|
||||
whenIsJust ((,) <$> appRes <*> crfApplicationFiles) $ \(appId, fSource) -> do
|
||||
runConduit $ transPipe liftHandler fSource .| C.mapM_ (insert_ . review _FileReference . (, CourseApplicationFileResidual appId))
|
||||
return appRes
|
||||
| otherwise
|
||||
= return $ Just ()
|
||||
mkRegistration = do
|
||||
audit $ TransactionCourseParticipantEdit cid uid
|
||||
memcachedByInvalidate (AuthCacheCourseRegisteredList courseTerm courseSchool courseShorthand) (Proxy @(Set UserId))
|
||||
entityKey <$> upsert
|
||||
(CourseParticipant cid uid cTime Nothing CourseParticipantActive)
|
||||
(CourseParticipant cid uid cTime CourseParticipantActive)
|
||||
[ CourseParticipantRegistration =. cTime
|
||||
, CourseParticipantAllocated =. Nothing
|
||||
, CourseParticipantState =. CourseParticipantActive
|
||||
]
|
||||
|
||||
case courseRegisterButton of
|
||||
BtnCourseRegister -> runDB . bool id setSerializable doApplication $ do
|
||||
regOk <- (\app reg -> (, reg) <$> app) <$> mkApplication <*> mkRegistration
|
||||
case regOk of
|
||||
Nothing -> transactionUndo
|
||||
Just _ -> addMessageIconI Success IconEnrolTrue MsgCourseRegisterOk
|
||||
BtnCourseRegister -> runDB $ do
|
||||
void mkRegistration
|
||||
addMessageIconI Success IconEnrolTrue MsgCourseRegisterOk
|
||||
BtnCourseDeregister -> runDB . setSerializable $ do
|
||||
part <- fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy $ UniqueParticipant uid cid
|
||||
forM_ part $ \(Entity _partId CourseParticipant{..}) -> do
|
||||
forM_ part . const $ do
|
||||
deregisterParticipant uid course
|
||||
|
||||
when (is _Just courseParticipantAllocated) $ do
|
||||
updateBy (UniqueParticipant uid cid) [ CourseParticipantState =. CourseParticipantInactive courseDeregisterNoShow ]
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
insert_ $ AllocationDeregister courseParticipantUser (Just courseParticipantCourse) now Nothing
|
||||
let recordNoShow eId = do
|
||||
didRecord <- is _Just <$> insertUnique ExamResult
|
||||
{ examResultExam = eId
|
||||
, examResultUser = uid
|
||||
, examResultResult = ExamNoShow
|
||||
, examResultLastChanged = now
|
||||
}
|
||||
when didRecord $
|
||||
audit $ TransactionExamResultEdit eId uid
|
||||
when courseDeregisterNoShow . runConduit $ selectKeys [ ExamCourse ==. cid ] [] .| C.mapM_ recordNoShow
|
||||
|
||||
addMessageIconI Info IconEnrolFalse MsgCourseDeregisterOk
|
||||
BtnCourseApply -> runDB . setSerializable $ do
|
||||
regOk <- mkApplication
|
||||
case regOk of
|
||||
Nothing -> transactionUndo
|
||||
Just _ -> addMessageIconI Success IconApplyTrue MsgCourseApplyOk
|
||||
BtnCourseRetractApplication -> runDB $ do
|
||||
deleteApplications uid cid
|
||||
addMessageIconI Info IconApplyFalse MsgCourseRetractApplyOk
|
||||
muid <- maybeAuthId
|
||||
ata <- getSessionActiveAuthTags
|
||||
now <- liftIO getCurrentTime
|
||||
courseVisible <- runDB . E.selectExists . E.from $ \(course' `E.LeftOuterJoin` allocation) -> do
|
||||
E.on . E.exists . E.from $ \allocationCourse ->
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course' E.^. CourseId
|
||||
E.&&. E.just (allocationCourse E.^. AllocationCourseAllocation) E.==. allocation E.?. AllocationId
|
||||
courseVisible <- runDB . E.selectExists . E.from $ \course' -> do
|
||||
E.where_ $ course' E.^. CourseId E.==. E.val cid
|
||||
E.&&. mayViewCourse muid ata now course' (allocation E.?. AllocationId)
|
||||
E.&&. mayViewCourse muid ata now course'
|
||||
redirect $ bool NewsR (CourseR tid ssh csh CShowR) courseVisible
|
||||
|
||||
deleteApplications :: UserId -> CourseId -> DB ()
|
||||
deleteApplications uid cid = do
|
||||
appIds <- selectKeysList [ CourseApplicationAllocation ==. Nothing, CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid ] []
|
||||
forM_ appIds $ \appId -> do
|
||||
deleteApplicationFiles appId
|
||||
delete appId
|
||||
audit $ TransactionCourseApplicationDeleted cid uid appId
|
||||
|
||||
deleteApplicationFiles :: CourseApplicationId -> DB ()
|
||||
deleteApplicationFiles appId = deleteWhere [ CourseApplicationFileApplication ==. appId ]
|
||||
|
||||
deregisterParticipant :: UserId -> Entity Course -> DB ()
|
||||
deregisterParticipant uid (Entity cid Course{..}) = do
|
||||
|
||||
@ -4,7 +4,6 @@
|
||||
|
||||
module Handler.Course.Show
|
||||
( getCShowR
|
||||
, getCRegisterTemplateR, courseRegisterTemplateSource
|
||||
) where
|
||||
|
||||
import Import
|
||||
@ -25,8 +24,6 @@ import Database.Esqueleto.Utils.TH
|
||||
|
||||
import Handler.Course.Register
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
import Handler.Exam.List (mkExamTable)
|
||||
|
||||
|
||||
@ -34,16 +31,13 @@ getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getCShowR tid ssh csh = do
|
||||
mbAid <- maybeAuthId
|
||||
now <- liftIO getCurrentTime
|
||||
(cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,administrators,correctors,tutors,mAllocation,mApplicationTemplate,mApplication,news,events,submissionGroup,hasAllocationRegistrationOpen,mayReRegister,(mayViewSheets, mayViewAnySheet), (mayViewMaterials, mayViewAnyMaterial)) <- runDB . maybeT notFound $ do
|
||||
[(E.Entity cid course, E.Value courseVisible, E.Value schoolName, E.Value participants, fmap entityVal -> registration, E.Value hasAllocationRegistrationOpen)]
|
||||
(cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,administrators,correctors,tutors,news,events,submissionGroup,_mayReRegister,(mayViewSheets, mayViewAnySheet), (mayViewMaterials, mayViewAnyMaterial)) <- runDB . maybeT notFound $ do
|
||||
[(E.Entity cid course, E.Value courseVisible, E.Value schoolName, E.Value participants, fmap entityVal -> registration)]
|
||||
<- lift . E.select . E.from $
|
||||
\((school `E.InnerJoin` course) `E.LeftOuterJoin` allocation `E.LeftOuterJoin` participant) -> do
|
||||
\((school `E.InnerJoin` course) `E.LeftOuterJoin` participant) -> do
|
||||
E.on $ E.just (course E.^. CourseId) E.==. participant E.?. CourseParticipantCourse
|
||||
E.&&. E.val mbAid E.==. participant E.?. CourseParticipantUser
|
||||
E.&&. participant E.?. CourseParticipantState E.==. E.just (E.val CourseParticipantActive)
|
||||
E.on . E.exists . E.from $ \allocationCourse ->
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.&&. E.just (allocationCourse E.^. AllocationCourseAllocation) E.==. allocation E.?. AllocationId
|
||||
E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
|
||||
E.where_ $ course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
@ -54,11 +48,10 @@ getCShowR tid ssh csh = do
|
||||
E.where_ $ part E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
||||
E.&&. part E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
return ( course
|
||||
, courseIsVisible now course $ allocation E.?. AllocationId
|
||||
, courseIsVisible now course
|
||||
, school E.^. SchoolName
|
||||
, numParticipants
|
||||
, participant
|
||||
, courseAllocationRegistrationOpen now (course E.^. CourseId) $ allocation E.?. AllocationId
|
||||
)
|
||||
staff <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do
|
||||
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
|
||||
@ -82,17 +75,6 @@ getCShowR tid ssh csh = do
|
||||
E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid
|
||||
E.orderBy [ E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName ]
|
||||
return ( user E.^. UserDisplayEmail, user E.^. UserDisplayName, user E.^. UserSurname )
|
||||
mAllocation <- fmap (fmap entityVal . listToMaybe) . lift . E.select . E.from $ \(allocation `E.InnerJoin` allocationCourse) -> do
|
||||
E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. E.val cid
|
||||
E.limit 1
|
||||
return allocation
|
||||
hasApplicationTemplate <- lift . E.selectExists . E.from $ \courseAppInstructionFile ->
|
||||
E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. E.val cid
|
||||
mApplicationTemplate <- runMaybeT $ do
|
||||
guard hasApplicationTemplate
|
||||
lift . lift . toTextUrl $ CourseR tid ssh csh CRegisterTemplateR
|
||||
mApplication <- lift . fmap (listToMaybe =<<) . for mbAid $ \uid -> selectList [CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid, CourseApplicationAllocation ==. Nothing] []
|
||||
news' <- lift $ selectList [ CourseNewsCourse ==. cid ] [ Desc CourseNewsVisibleFrom, Desc CourseNewsTitle, Desc CourseNewsSummary, Desc CourseNewsContent ]
|
||||
cTime <- NTop . Just <$> liftIO getCurrentTime
|
||||
news <- forMaybeM news' $ \(Entity nId n@CourseNews{..}) -> do
|
||||
@ -146,14 +128,10 @@ getCShowR tid ssh csh = do
|
||||
return $ material E.^. MaterialName
|
||||
mayViewAnyMaterial <- lift . anyM materials $ \(E.Value mnm) -> hasReadAccessTo $ CMaterialR tid ssh csh mnm MShowR
|
||||
|
||||
return (cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,administrators,correctors,tutors,mAllocation,mApplicationTemplate,mApplication,news,events,submissionGroup,hasAllocationRegistrationOpen,mayReRegister, (mayViewSheets, mayViewAnySheet), (mayViewMaterials, mayViewAnyMaterial))
|
||||
return (cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,administrators,correctors,tutors,news,events,submissionGroup,mayReRegister, (mayViewSheets, mayViewAnySheet), (mayViewMaterials, mayViewAnyMaterial))
|
||||
|
||||
let mDereg' = maybe id min (allocationOverrideDeregister =<< mAllocation) <$> courseDeregisterUntil course
|
||||
mDereg <- traverse (formatTime SelFormatDateTime) mDereg'
|
||||
mDereg <- traverse (formatTime SelFormatDateTime) $ courseDeregisterUntil course
|
||||
|
||||
cID <- encrypt cid :: Handler CryptoUUIDCourse
|
||||
mAllocation' <- for mAllocation $ \alloc@Allocation{..} -> (alloc, )
|
||||
<$> toTextUrl (AllocationR allocationTerm allocationSchool allocationShorthand AShowR :#: cID)
|
||||
regForm <- if
|
||||
| is _Just mbAid -> do
|
||||
(courseRegisterForm', regButton) <- courseRegisterForm (Entity cid course)
|
||||
@ -282,16 +260,3 @@ getCShowR tid ssh csh = do
|
||||
siteLayout heading $ do
|
||||
setTitleI $ prependCourseTitle tid ssh csh (""::Text)
|
||||
$(widgetFile "course")
|
||||
|
||||
courseRegisterTemplateSource :: TermId -> SchoolId -> CourseShorthand -> ConduitT () CourseAppInstructionFile (YesodDB UniWorX) ()
|
||||
courseRegisterTemplateSource tid ssh csh = (.| C.map entityVal) . E.selectSource . E.from $ \(courseAppInstructionFile `E.InnerJoin` course) -> do
|
||||
E.on $ course E.^. CourseId E.==. courseAppInstructionFile E.^. CourseAppInstructionFileCourse
|
||||
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
|
||||
return courseAppInstructionFile
|
||||
|
||||
getCRegisterTemplateR :: TermId -> SchoolId -> CourseShorthand -> Handler TypedContent
|
||||
getCRegisterTemplateR tid ssh csh = do
|
||||
archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack). ap getMessageRender . pure $ MsgCourseApplicationTemplateArchiveName tid ssh csh
|
||||
serveSomeFiles archiveName $ courseRegisterTemplateSource tid ssh csh
|
||||
|
||||
@ -32,7 +32,6 @@ import qualified Data.Map as Map
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
import qualified Data.Conduit.Combinators as C
|
||||
import qualified Data.Text.Lazy as LT
|
||||
|
||||
|
||||
@ -113,16 +112,7 @@ courseUserProfileSection course@(Entity cid Course{..}) (Entity uid User{ userSh
|
||||
let regButton
|
||||
| is _Just mRegistration = BtnCourseDeregister
|
||||
| otherwise = BtnCourseRegister
|
||||
((regButtonRes, regButtonView), regButtonEnctype) <- lift . runFormPost . identifyForm FIDcRegButton $
|
||||
if | is _Just $ courseParticipantAllocated . entityVal =<< mRegistration
|
||||
-> renderWForm FormStandard $ fmap (regButton, )
|
||||
<$ (wformMessage =<< messageIconI Warning IconEnrolFalse MsgCourseDeregistrationAllocationShouldLogTip)
|
||||
<*> optionalActionW ((,)
|
||||
<$> areq (textField & cfStrip & guardField (not . null)) (fslI MsgCourseDeregistrationAllocationReason & setTooltip MsgCourseDeregistrationAllocationReasonTip) Nothing
|
||||
<*> apopt checkBoxField (fslI MsgCourseDeregistrationAllocationNoShow & setTooltip MsgCourseDeregistrationAllocationNoShowTip) Nothing
|
||||
) (fslI MsgCourseDeregistrationAllocationShouldLog) (Just True)
|
||||
| otherwise
|
||||
-> \csrf -> pure (FormSuccess (regButton, Nothing), toWidget csrf)
|
||||
((regButtonRes, regButtonView), regButtonEnctype) <- lift . runFormPost . identifyForm FIDcRegButton $ \csrf -> pure (FormSuccess (regButton, Nothing), toWidget csrf)
|
||||
|
||||
let registrationButtonFrag :: Text
|
||||
registrationButtonFrag = "registration-button"
|
||||
@ -145,21 +135,8 @@ courseUserProfileSection course@(Entity cid Course{..}) (Entity uid User{ userSh
|
||||
unless (courseParticipantCourse == cid) $ error "courseParticipantCourse does not match cid"
|
||||
deregisterParticipant courseParticipantUser course
|
||||
|
||||
whenIsJust mbReason $ \(reason, noShow) -> do
|
||||
whenIsJust mbReason $ \(_reason, noShow) -> do
|
||||
updateBy (UniqueParticipant uid cid) [ CourseParticipantState =. CourseParticipantInactive noShow ]
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
insert_ $ AllocationDeregister courseParticipantUser (Just cid) now (Just reason)
|
||||
let recordNoShow eId = do
|
||||
didRecord <- is _Just <$> insertUnique ExamResult
|
||||
{ examResultExam = eId
|
||||
, examResultUser = uid
|
||||
, examResultResult = ExamNoShow
|
||||
, examResultLastChanged = now
|
||||
}
|
||||
when didRecord $
|
||||
audit $ TransactionExamResultEdit eId uid
|
||||
when noShow . runConduit $ selectKeys [ ExamCourse ==. cid ] [] .| C.mapM_ recordNoShow
|
||||
addMessageIconI Info IconEnrolFalse MsgCourseDeregisterOk
|
||||
redirect $ CourseR courseTerm courseSchool courseShorthand CUsersR
|
||||
| otherwise
|
||||
@ -168,16 +145,14 @@ courseUserProfileSection course@(Entity cid Course{..}) (Entity uid User{ userSh
|
||||
now <- liftIO getCurrentTime
|
||||
lift . runDBJobs $ do
|
||||
void $ upsert
|
||||
(CourseParticipant cid uid now Nothing CourseParticipantActive)
|
||||
(CourseParticipant cid uid now CourseParticipantActive)
|
||||
[ CourseParticipantRegistration =. now
|
||||
, CourseParticipantAllocated =. Nothing
|
||||
, CourseParticipantState =. CourseParticipantActive
|
||||
]
|
||||
queueDBJob . JobQueueNotification $ NotificationCourseRegistered uid cid
|
||||
audit $ TransactionCourseParticipantEdit cid uid
|
||||
addMessageIconI Success IconEnrolTrue MsgCourseRegisterOk
|
||||
redirect currentRoute
|
||||
_other -> error "Invalid @regButton@"
|
||||
|
||||
mRegAt <- for (courseParticipantRegistration . entityVal <$> mRegistration) $ formatTime SelFormatDateTime
|
||||
|
||||
|
||||
@ -595,18 +595,7 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
|
||||
return (act, usrSet)
|
||||
|
||||
courseUserDeregisterForm :: CourseId -> AForm Handler CourseUserActionData
|
||||
courseUserDeregisterForm cid = wFormToAForm $ do
|
||||
allocated <- liftHandler . runDB . E.selectExists . E.from $ \participant ->
|
||||
E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
|
||||
E.&&. E.not_ (E.isNothing $ participant E.^. CourseParticipantAllocated)
|
||||
E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
if | allocated -> do
|
||||
wformMessage =<< messageIconI Warning IconEnrolFalse MsgCourseDeregistrationAllocationShouldLogTip
|
||||
let selfImposedForm = (,)
|
||||
<$> apreq (textField & cfStrip & guardField (not . null)) (fslI MsgCourseDeregistrationAllocationReason & setTooltip MsgCourseDeregistrationAllocationReasonTip) Nothing
|
||||
<*> apopt checkBoxField (fslI MsgCourseDeregistrationAllocationNoShow & setTooltip MsgCourseDeregistrationAllocationNoShowTip) Nothing
|
||||
fmap CourseUserDeregisterData <$> optionalActionW selfImposedForm (fslI MsgCourseDeregistrationAllocationShouldLog) (Just True)
|
||||
| otherwise -> pure . pure $ CourseUserDeregisterData Nothing
|
||||
courseUserDeregisterForm _cid = wFormToAForm . pure . pure $ CourseUserDeregisterData Nothing
|
||||
|
||||
getCUsersR, postCUsersR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getCUsersR = postCUsersR
|
||||
@ -706,28 +695,11 @@ postCUsersR tid ssh csh = do
|
||||
(CourseUserSendMailData, selectedUsers) -> do
|
||||
cids <- traverse encrypt $ Set.toList selectedUsers :: Handler [CryptoUUIDUser]
|
||||
redirect (CourseR tid ssh csh CCommR, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cids])
|
||||
(CourseUserDeregisterData{..}, selectedUsers) -> do
|
||||
(CourseUserDeregisterData{}, selectedUsers) -> do
|
||||
Sum nrDel <- fmap mconcat . runDB . forM (Set.toList selectedUsers) $ \uid -> fmap (maybe mempty Sum) . runMaybeT $ do
|
||||
now <- liftIO getCurrentTime
|
||||
Entity _ CourseParticipant{..} <- MaybeT . fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy $ UniqueParticipant uid cid
|
||||
unless (courseParticipantCourse == cid) $ error "courseParticipantCourse does not match cid"
|
||||
lift $ deregisterParticipant courseParticipantUser course
|
||||
case deregisterSelfImposed of
|
||||
Just (reason, noShow)
|
||||
| is _Just courseParticipantAllocated -> lift $ do
|
||||
insert_ $ AllocationDeregister uid (Just cid) now (Just reason)
|
||||
updateBy (UniqueParticipant uid cid) [ CourseParticipantState =. CourseParticipantInactive noShow ]
|
||||
let recordNoShow eId = do
|
||||
didRecord <- is _Just <$> insertUnique ExamResult
|
||||
{ examResultExam = eId
|
||||
, examResultUser = uid
|
||||
, examResultResult = ExamNoShow
|
||||
, examResultLastChanged = now
|
||||
}
|
||||
when didRecord $
|
||||
audit $ TransactionExamResultEdit eId uid
|
||||
when noShow . runConduit $ selectKeys [ ExamCourse ==. cid ] [] .| C.mapM_ recordNoShow
|
||||
_other -> return ()
|
||||
return 1
|
||||
addMessageI Success $ MsgCourseUsersDeregistered nrDel
|
||||
redirect $ CourseR tid ssh csh CUsersR
|
||||
@ -773,10 +745,8 @@ postCUsersR tid ssh csh = do
|
||||
]
|
||||
[ CourseParticipantState =. CourseParticipantActive
|
||||
, CourseParticipantRegistration =. now
|
||||
, CourseParticipantAllocated =. Nothing
|
||||
]
|
||||
guard $ didUpdate > 0
|
||||
lift $ deleteWhere [ AllocationDeregisterCourse ==. Just cid, AllocationDeregisterUser ==. uid ]
|
||||
lift . audit $ TransactionCourseParticipantEdit cid uid
|
||||
return $ Sum didUpdate
|
||||
addMessageI Success $ MsgCourseUsersStateSet nrSet
|
||||
|
||||
@ -141,12 +141,10 @@ postEAddUserR tid ssh csh examn = do
|
||||
{ courseParticipantCourse = cid
|
||||
, courseParticipantUser = uid
|
||||
, courseParticipantRegistration = now
|
||||
, courseParticipantAllocated = Nothing
|
||||
, courseParticipantState = CourseParticipantActive
|
||||
, ..
|
||||
}
|
||||
[ CourseParticipantRegistration =. now
|
||||
, CourseParticipantAllocated =. Nothing
|
||||
, CourseParticipantState =. CourseParticipantActive
|
||||
]
|
||||
lift . lift . audit $ TransactionCourseParticipantEdit cid uid
|
||||
|
||||
@ -102,9 +102,8 @@ examRegistrationInvitationConfig = InvitationConfig{..}
|
||||
invitationInsertHook _ (Entity eid Exam{..}) _ ExamRegistration{..} doReg act = do
|
||||
when doReg $ do
|
||||
void $ upsert
|
||||
(CourseParticipant examCourse examRegistrationUser examRegistrationTime Nothing CourseParticipantActive)
|
||||
(CourseParticipant examCourse examRegistrationUser examRegistrationTime CourseParticipantActive)
|
||||
[ CourseParticipantRegistration =. examRegistrationTime
|
||||
, CourseParticipantAllocated =. Nothing
|
||||
, CourseParticipantState =. CourseParticipantActive
|
||||
]
|
||||
queueDBJob . JobQueueNotification $ NotificationCourseRegistered examRegistrationUser examCourse
|
||||
|
||||
@ -756,11 +756,9 @@ postEUsersR tid ssh csh examn = do
|
||||
{ courseParticipantCourse = examCourse
|
||||
, courseParticipantUser = examUserCsvActUser
|
||||
, courseParticipantRegistration = now
|
||||
, courseParticipantAllocated = Nothing
|
||||
, courseParticipantState = CourseParticipantActive
|
||||
}
|
||||
[ CourseParticipantRegistration =. now
|
||||
, CourseParticipantAllocated =. Nothing
|
||||
, CourseParticipantState =. CourseParticipantActive
|
||||
]
|
||||
queueDBJob . JobQueueNotification $ NotificationCourseRegistered examUserCsvActUser examCourse
|
||||
|
||||
@ -204,21 +204,6 @@ showFAQ _ FAQInvalidCredentialsAdAccountDisabled = maybeT (return False) $ do
|
||||
sessionError <- MaybeT $ lookupSessionJson SessionError
|
||||
guard $ sessionError == PermissionDenied (toPathPiece $ ADInvalidCredentials ADAccountDisabled)
|
||||
return True
|
||||
showFAQ _ FAQAllocationNoPlaces = maybeT (return False) $ do
|
||||
uid <- MaybeT maybeAuthId
|
||||
now <- liftIO getCurrentTime
|
||||
liftHandler . runDB . E.selectExists . E.from $ \allocation -> do
|
||||
let doneSince = E.subSelectMaybe . E.from $ \participant -> do
|
||||
E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (allocation E.^. AllocationId)
|
||||
return . E.max_ $ participant E.^. CourseParticipantRegistration
|
||||
isAllocationUser = E.exists . E.from $ \allocationUser ->
|
||||
E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. allocation E.^. AllocationId
|
||||
E.&&. allocationUser E.^. AllocationUserUser E.==. E.val uid
|
||||
isApplicant = E.exists . E.from $ \courseApplication ->
|
||||
E.where_ $ courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocation E.^. AllocationId)
|
||||
E.&&. courseApplication E.^. CourseApplicationUser E.==. E.val uid
|
||||
E.where_ $ isAllocationUser E.||. isApplicant
|
||||
E.where_ $ E.maybe E.false (\done -> done E.>=. E.val (addUTCTime (-7 * nominalDay) now)) doneSince
|
||||
showFAQ _ _ = return False
|
||||
|
||||
prioFAQ :: Monad m
|
||||
@ -229,7 +214,6 @@ prioFAQ _ FAQForgottenPassword = return 1
|
||||
prioFAQ _ FAQNotLecturerHowToCreateCourses = return 1
|
||||
prioFAQ _ FAQCourseCorrectorsTutors = return 1
|
||||
prioFAQ _ FAQExamPoints = return 2
|
||||
prioFAQ _ FAQAllocationNoPlaces = return 2
|
||||
prioFAQ _ FAQInvalidCredentialsAdAccountDisabled = return 3
|
||||
|
||||
|
||||
@ -239,10 +223,6 @@ getInfoLecturerR =
|
||||
setTitleI MsgInfoLecturerTitle
|
||||
$(i18nWidgetFile "info-lecturer")
|
||||
where
|
||||
allocationInfo = do
|
||||
faqItemUrlAllocationNoPlaces <- toTextUrl $ FaqR :#: FAQAllocationNoPlaces
|
||||
$(i18nWidgetFile "allocation-info")
|
||||
|
||||
tooltipNew, tooltipProblem, tooltipPlanned, tooltipNewU2W :: WidgetFor UniWorX ()
|
||||
tooltipNew = [whamlet| _{MsgLecturerInfoTooltipNew} |]
|
||||
tooltipProblem = [whamlet| _{MsgLecturerInfoTooltipProblem} |]
|
||||
|
||||
@ -26,8 +26,6 @@ import qualified Data.HashMap.Strict as HashMap
|
||||
|
||||
import Handler.Utils.Exam (showExamOccurrenceRoom)
|
||||
|
||||
import Data.List (maximum, minimum, minimumBy)
|
||||
|
||||
|
||||
getNewsR :: Handler Html
|
||||
getNewsR = do
|
||||
@ -42,7 +40,6 @@ getNewsR = do
|
||||
|
||||
case muid of
|
||||
Just uid -> do
|
||||
newsActiveAllocations uid
|
||||
newsUpcomingExams uid
|
||||
newsUpcomingSheets uid
|
||||
Nothing ->
|
||||
@ -355,167 +352,3 @@ newsUpcomingExams uid = do
|
||||
(, userWarningDays) <$> dbTable examDBTableValidator examDBTable
|
||||
|
||||
$(widgetFile "news/upcomingExams")
|
||||
|
||||
|
||||
data AllocationUtilInfo = AllocationUtilInfo
|
||||
{ auiApplicants
|
||||
, auiPlaces
|
||||
, auiPlacementsMade
|
||||
, auiApplicantsPlaced :: Word64
|
||||
} deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
|
||||
newsActiveAllocations :: UserId -> Widget
|
||||
newsActiveAllocations uid = maybeT_ $ do
|
||||
now <- liftIO getCurrentTime
|
||||
activeAllocs <- hoist (liftHandler . runDB) $ do
|
||||
guardM . lift $ or2M (hasWriteAccessTo CourseNewR) (hasWriteAccessTo AllocationNewR)
|
||||
|
||||
userSchools <- lift . fmap (map E.unValue) . E.select . E.from $ \userSchool -> E.distinctOnOrderBy [E.asc $ userSchool E.^. UserSchoolSchool] $ do
|
||||
E.where_ $ userSchool E.^. UserSchoolUser E.==. E.val uid
|
||||
return $ userSchool E.^. UserSchoolSchool
|
||||
functionSchools <- lift . fmap (map E.unValue) . E.select . E.from $ \userFunction -> E.distinctOnOrderBy [E.asc $ userFunction E.^. UserFunctionSchool] $ do
|
||||
E.where_ $ userFunction E.^. UserFunctionUser E.==. E.val uid
|
||||
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolAllocation
|
||||
return $ userFunction E.^. UserFunctionSchool
|
||||
|
||||
let allocSchools = Set.fromList $ userSchools <> functionSchools
|
||||
|
||||
guard . not $ null allocSchools
|
||||
|
||||
activeAllocs <- lift . E.select . E.from $ \allocation -> do
|
||||
E.where_ $ allocation E.^. AllocationSchool `E.in_` E.valList (Set.toList allocSchools)
|
||||
E.where_ $ E.maybe E.false (E.<=. E.val now) (allocation E.^. AllocationStaffRegisterFrom) E.&&. E.maybe E.true (E.>=. E.val now) (allocation E.^. AllocationStaffRegisterTo)
|
||||
E.||. E.maybe E.false (E.<=. E.val now) (allocation E.^. AllocationStaffAllocationFrom) E.&&. E.maybe E.true (E.>=. E.val now) (allocation E.^. AllocationStaffAllocationTo)
|
||||
E.||. E.maybe E.false (E.<=. E.val now) (allocation E.^. AllocationRegisterFrom) E.&&. E.maybe E.true (E.>=. E.val now) (allocation E.^. AllocationRegisterTo)
|
||||
E.||. E.maybe E.true (E.>=. E.val now) (allocation E.^. AllocationRegisterByStaffFrom) E.||. E.maybe E.false (E.<=. E.val now) (allocation E.^. AllocationRegisterByStaffTo)
|
||||
E.||. E.maybe E.false (E.>=. E.val now) (allocation E.^. AllocationRegisterByCourse)
|
||||
|
||||
return allocation
|
||||
|
||||
guard . not $ null activeAllocs
|
||||
|
||||
fmap Map.fromList . forM activeAllocs $ \activeAlloc'@(Entity _ activeAlloc) -> lift $ ((allocationTerm activeAlloc, allocationSchool activeAlloc, allocationShorthand activeAlloc), ) <$> do
|
||||
prevAllocs <- E.select . E.from $ \allocation -> E.distinctOnOrderBy [ E.desc $ allocation E.^. AllocationTerm ] $ do
|
||||
E.where_ $ allocation E.^. AllocationShorthand `E.in_` E.valList (allocationShorthand activeAlloc : allocationLegacyShorthands activeAlloc)
|
||||
E.&&. allocation E.^. AllocationTerm E.<. E.val (allocationTerm activeAlloc)
|
||||
E.&&. allocation E.^. AllocationSchool E.==. E.val (allocationSchool activeAlloc)
|
||||
E.orderBy [E.asc $ allocation E.^. AllocationSchool]
|
||||
E.limit 2
|
||||
return allocation
|
||||
|
||||
let allocInfo :: Entity Allocation -> DB (Entity Allocation, AllocationUtilInfo)
|
||||
allocInfo ent@(Entity aId' _) = (ent, ) <$> do
|
||||
auiApplicants <- E.selectCountRows . E.from $ \allocationUser -> do
|
||||
E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. E.val aId'
|
||||
E.where_ $ allocationUser E.^. AllocationUserTotalCourses E.>=. E.val 1 -- wants at least one course
|
||||
E.where_ . E.exists . E.from $ \(courseApplication `E.InnerJoin` allocationCourse) -> do -- at least one application
|
||||
E.on $ courseApplication E.^. CourseApplicationCourse E.==. allocationCourse E.^. AllocationCourseCourse
|
||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId'
|
||||
E.where_ $ courseApplication E.^. CourseApplicationUser E.==. allocationUser E.^. AllocationUserUser
|
||||
E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.justVal aId'
|
||||
auiPlaces <- fmap (fromMaybe 0 . (E.unValue =<<)) . E.selectMaybe . E.from $ \(allocationCourse `E.InnerJoin` course) -> do
|
||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId'
|
||||
return . E.explicitUnsafeCoerceSqlExprValue @(Maybe Word64) @(Maybe Rational) "integer" . E.sum_ . E.maybe (E.val 0) id . E.maybe (course E.^. CourseCapacity) E.just $ allocationCourse E.^. AllocationCourseOverrideSumCapacity
|
||||
placementsCounts <- E.select . E.from $ \(courseParticipant `E.InnerJoin` allocationCourse) -> do
|
||||
E.on $ courseParticipant E.^. CourseParticipantCourse E.==. allocationCourse E.^. AllocationCourseCourse
|
||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId'
|
||||
E.where_ . E.isJust $ courseParticipant E.^. CourseParticipantAllocated -- count any allocations; course can only be in one allocation at a time
|
||||
return ( E.countRows
|
||||
, E.countDistinct $ courseParticipant E.^. CourseParticipantUser
|
||||
)
|
||||
let (auiPlacementsMade, auiApplicantsPlaced) = case placementsCounts of
|
||||
[(E.Value placementsMade, E.Value applicantsPlaced)] -> (placementsMade, applicantsPlaced)
|
||||
_other -> error "Query `SELECT COUNT(*), COUNT(DISTINCT …) …` did not return exactly one row"
|
||||
return AllocationUtilInfo{..}
|
||||
|
||||
(:|) <$> allocInfo activeAlloc'
|
||||
<*> traverse allocInfo prevAllocs
|
||||
|
||||
let allocsToList allocs = toList allocs
|
||||
& sortOn (Down . allocationTerm . views _1 entityVal)
|
||||
allocationInfo = $(i18nWidgetFile "news/activeAllocations-info")
|
||||
allocTime Allocation{..} | null timeOpts' = Nothing
|
||||
| otherwise = Just . view _2 $ minimumBy (comparing $ view _1) timeOpts'
|
||||
where
|
||||
timeOpts' = flip mapMaybe timeOpts $ \(ts, w)
|
||||
-> let ts' = flip mapMaybe ts $ \mt -> assertM' (>= 0) . (`diffUTCTime` now) =<< mt
|
||||
in if | null ts' -> Nothing
|
||||
| otherwise -> Just (minimum ts', w)
|
||||
timeOpts = catMaybes
|
||||
[ allocationRegisterByStaffFrom <&> \registerByStaffFrom ->
|
||||
( [allocationRegisterByStaffFrom, allocationRegisterByStaffTo]
|
||||
, [whamlet|
|
||||
$newline never
|
||||
_{MsgAllocationRegisterByStaff}: #
|
||||
^{formatTimeRangeW (selFormat $ catMaybes [allocationRegisterByStaffFrom, allocationRegisterByStaffTo]) registerByStaffFrom allocationRegisterByStaffTo}
|
||||
|]
|
||||
)
|
||||
, allocationRegisterByStaffTo <&> \registerByStaffTo ->
|
||||
( [allocationRegisterByStaffTo]
|
||||
, [whamlet|
|
||||
$newline never
|
||||
_{MsgAllocationRegisterByStaffTo}: #
|
||||
^{formatTimeW (selFormat $ catMaybes [allocationRegisterByStaffTo]) registerByStaffTo}
|
||||
|]
|
||||
)
|
||||
, allocationStaffRegisterFrom <&> \staffRegisterFrom ->
|
||||
( [allocationStaffRegisterFrom, allocationStaffRegisterTo]
|
||||
, [whamlet|
|
||||
$newline never
|
||||
_{MsgAllocationStaffRegister}: #
|
||||
^{formatTimeRangeW (selFormat $ catMaybes [allocationStaffRegisterFrom, allocationStaffRegisterTo]) staffRegisterFrom allocationStaffRegisterTo}
|
||||
|]
|
||||
)
|
||||
, allocationStaffRegisterTo <&> \staffRegisterTo ->
|
||||
( [allocationStaffRegisterTo]
|
||||
, [whamlet|
|
||||
$newline never
|
||||
_{MsgAllocationStaffRegisterTo}: #
|
||||
^{formatTimeW (selFormat $ catMaybes [allocationStaffRegisterTo]) staffRegisterTo}
|
||||
|]
|
||||
)
|
||||
, allocationRegisterFrom <&> \registerFrom ->
|
||||
( [allocationRegisterFrom, allocationRegisterTo]
|
||||
, [whamlet|
|
||||
$newline never
|
||||
_{MsgAllocationRegister}: #
|
||||
^{formatTimeRangeW (selFormat $ catMaybes [allocationRegisterFrom, allocationRegisterTo]) registerFrom allocationRegisterTo}
|
||||
|]
|
||||
)
|
||||
, allocationRegisterTo <&> \registerTo ->
|
||||
( [allocationRegisterTo]
|
||||
, [whamlet|
|
||||
$newline never
|
||||
_{MsgAllocationRegisterTo}: #
|
||||
^{formatTimeW (selFormat $ catMaybes [allocationRegisterTo]) registerTo}
|
||||
|]
|
||||
)
|
||||
, allocationStaffAllocationFrom <&> \staffAllocationFrom ->
|
||||
( [allocationStaffAllocationFrom, allocationStaffAllocationTo]
|
||||
, [whamlet|
|
||||
$newline never
|
||||
_{MsgAllocationStaffAllocation}: #
|
||||
^{formatTimeRangeW (selFormat $ catMaybes [allocationStaffAllocationFrom, allocationStaffAllocationTo]) staffAllocationFrom allocationStaffAllocationTo}
|
||||
|]
|
||||
)
|
||||
, allocationStaffAllocationTo <&> \staffAllocationTo ->
|
||||
( [allocationStaffAllocationTo]
|
||||
, [whamlet|
|
||||
$newline never
|
||||
_{MsgAllocationStaffAllocationTo}: #
|
||||
^{formatTimeW (selFormat $ catMaybes [allocationStaffAllocationTo]) staffAllocationTo}
|
||||
|]
|
||||
)
|
||||
]
|
||||
selFormat ts | not $ null ts = maximum $ map selFormat' ts
|
||||
| otherwise = SelFormatDate
|
||||
where selFormat' (utcToLocalTime -> t@LocalTime{..})
|
||||
| closeToEndOfDay = SelFormatDate
|
||||
| otherwise = SelFormatDateTime
|
||||
where closeToEndOfDay = any (\t' -> abs (t `diffLocalTime` t') <= 5 * nominalMinute)
|
||||
[ LocalTime localDay midnight
|
||||
, LocalTime (addDays 1 localDay) midnight
|
||||
]
|
||||
|
||||
lift $(widgetFile "news/activeAllocations")
|
||||
|
||||
@ -73,7 +73,6 @@ data SettingsForm = SettingsForm
|
||||
, stgExamOfficeSettings :: ExamOfficeSettings
|
||||
, stgSchools :: Set SchoolId
|
||||
, stgNotificationSettings :: NotificationSettings
|
||||
, stgAllocationNotificationSettings :: Map AllocationId (Maybe Bool)
|
||||
}
|
||||
makeLenses_ ''SettingsForm
|
||||
|
||||
@ -84,8 +83,6 @@ data NotificationTriggerKind
|
||||
| NTKExamParticipant
|
||||
| NTKCorrector
|
||||
| NTKCourseLecturer
|
||||
| NTKAllocationStaff
|
||||
| NTKAllocationParticipant
|
||||
| NTKFunctionary SchoolFunction
|
||||
deriving (Eq, Ord, Generic, Typeable)
|
||||
deriveFinite ''NotificationTriggerKind
|
||||
@ -98,25 +95,13 @@ instance RenderMessage UniWorX NotificationTriggerKind where
|
||||
NTKExamParticipant -> mr MsgNotificationTriggerKindExamParticipant
|
||||
NTKCorrector -> mr MsgNotificationTriggerKindCorrector
|
||||
NTKCourseLecturer -> mr MsgNotificationTriggerKindCourseLecturer
|
||||
NTKAllocationStaff -> mr MsgNotificationTriggerKindAllocationStaff
|
||||
NTKAllocationParticipant -> mr MsgNotificationTriggerKindAllocationParticipant
|
||||
NTKFunctionary SchoolAdmin -> mr MsgNotificationTriggerKindAdmin
|
||||
NTKFunctionary SchoolLecturer -> mr MsgNotificationTriggerKindLecturer
|
||||
NTKFunctionary SchoolExamOffice -> mr MsgNotificationTriggerKindExamOffice
|
||||
NTKFunctionary SchoolEvaluation -> mr MsgNotificationTriggerKindEvaluation
|
||||
NTKFunctionary SchoolAllocation -> mr MsgNotificationTriggerKindAllocationAdmin
|
||||
where
|
||||
mr = renderMessage f ls
|
||||
|
||||
data AllocationNotificationState
|
||||
= AllocNotifyNewCourseDefault
|
||||
| AllocNotifyNewCourseForceOff
|
||||
| AllocNotifyNewCourseForceOn
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
deriving anyclass (Universe, Finite)
|
||||
embedRenderMessage ''UniWorX ''AllocationNotificationState id
|
||||
nullaryPathPiece ''AllocationNotificationState $ camelToPathPiece' 2
|
||||
|
||||
|
||||
makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
|
||||
makeSettingForm template html = do
|
||||
@ -152,7 +137,6 @@ makeSettingForm template html = do
|
||||
<*> examOfficeForm (stgExamOfficeSettings <$> template)
|
||||
<*> schoolsForm (stgSchools <$> template)
|
||||
<*> notificationForm (stgNotificationSettings <$> template)
|
||||
<*> allocationNotificationForm (stgAllocationNotificationSettings <$> template)
|
||||
return (result, widget) -- no validation required here
|
||||
where
|
||||
themeList = [Option (toMessage t) t (toPathPiece t) | t <- universeF]
|
||||
@ -216,17 +200,6 @@ notificationForm template = wFormToAForm $ do
|
||||
| Just uid <- mbUid
|
||||
-> fmap not . E.selectExists . E.from $ \lecturer ->
|
||||
E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid
|
||||
NTKAllocationStaff
|
||||
| Just uid <- mbUid
|
||||
-> fmap not . E.selectExists . E.from $ \(lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> do
|
||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
|
||||
E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid
|
||||
NTKAllocationParticipant
|
||||
| Just uid <- mbUid
|
||||
-> fmap not . E.selectExists . E.from $ \courseApplication ->
|
||||
E.where_ $ courseApplication E.^. CourseApplicationUser E.==. E.val uid
|
||||
E.&&. E.not_ (E.isNothing $ courseApplication E.^. CourseApplicationAllocation)
|
||||
NTKFunctionary f
|
||||
| Just uid <- mbUid
|
||||
-> fmap not . E.selectExists . E.from $ \userFunction ->
|
||||
@ -242,7 +215,6 @@ notificationForm template = wFormToAForm $ do
|
||||
|
||||
let
|
||||
ntfs nt = fslI nt & case nt of
|
||||
NTAllocationNewCourse -> setTooltip MsgNotificationTriggerAllocationNewCourseTip
|
||||
_other -> id
|
||||
|
||||
nsForm nt
|
||||
@ -272,13 +244,6 @@ notificationForm template = wFormToAForm $ do
|
||||
NTExamRegistrationSoonInactive -> Just NTKCourseParticipant
|
||||
NTExamDeregistrationSoonInactive -> Just NTKCourseParticipant
|
||||
NTExamResult -> Just NTKExamParticipant
|
||||
NTAllocationStaffRegister -> Just $ NTKFunctionary SchoolLecturer
|
||||
NTAllocationAllocation -> Just NTKAllocationStaff
|
||||
NTAllocationRegister -> Just NTKAll
|
||||
NTAllocationOutdatedRatings -> Just NTKAllocationStaff
|
||||
NTAllocationUnratedApplications -> Just NTKAllocationStaff
|
||||
NTAllocationResults -> Just NTKAllocationParticipant
|
||||
NTAllocationNewCourse -> Just NTKAllocationParticipant
|
||||
NTExamOfficeExamResults -> Just $ NTKFunctionary SchoolExamOffice
|
||||
NTExamOfficeExamResultsChanged -> Just $ NTKFunctionary SchoolExamOffice
|
||||
NTCourseRegistered -> Just NTKAll
|
||||
@ -289,62 +254,6 @@ notificationForm template = wFormToAForm $ do
|
||||
|
||||
aFormToWForm $ NotificationSettings <$> sectionedFuncForm ntSection nsForm (fslI MsgNotificationSettings) False
|
||||
|
||||
getAllocationNotifications :: UserId -> DB (Map AllocationId (Maybe Bool))
|
||||
getAllocationNotifications uid
|
||||
= fmap (fmap (fmap getAny) . unMergeMap) . getAp $ foldMap (Ap . fmap (MergeMap . fmap (fmap Any)))
|
||||
[ getBySettings
|
||||
, getByApplications
|
||||
, getByAllocationUser
|
||||
]
|
||||
where
|
||||
getBySettings = toMap <$> selectList [ AllocationNotificationSettingUser ==. uid ] []
|
||||
where toMap settings = Map.fromList [ ( allocationNotificationSettingAllocation
|
||||
, Just $ not allocationNotificationSettingIsOptOut
|
||||
)
|
||||
| Entity _ AllocationNotificationSetting{..} <- settings
|
||||
]
|
||||
getByApplications = toMap <$> selectList [ CourseApplicationAllocation !=. Nothing, CourseApplicationUser ==. uid ] []
|
||||
where toMap applications = Map.fromList [ (alloc, Nothing)
|
||||
| Entity _ CourseApplication{..} <- applications
|
||||
, alloc <- hoistMaybe courseApplicationAllocation
|
||||
]
|
||||
getByAllocationUser = toMap <$> selectList [ AllocationUserUser ==. uid ] []
|
||||
where toMap allocsUser = Map.fromList [ (allocationUserAllocation, Nothing)
|
||||
| Entity _ AllocationUser{..} <- allocsUser
|
||||
]
|
||||
|
||||
setAllocationNotifications :: forall m. MonadIO m => UserId -> Map AllocationId (Maybe Bool) -> SqlPersistT m ()
|
||||
setAllocationNotifications allocationNotificationSettingUser allocs = do
|
||||
deleteWhere [ AllocationNotificationSettingUser ==. allocationNotificationSettingUser ]
|
||||
void . insertMany $ do
|
||||
(allocationNotificationSettingAllocation, settingSt) <- Map.toList allocs
|
||||
allocationNotificationSettingIsOptOut <- not <$> hoistMaybe settingSt
|
||||
return AllocationNotificationSetting{..}
|
||||
|
||||
allocationNotificationForm :: Maybe (Map AllocationId (Maybe Bool)) -> AForm Handler (Map AllocationId (Maybe Bool))
|
||||
allocationNotificationForm = maybe (pure mempty) allocationNotificationForm' . (fromNullable =<<)
|
||||
where
|
||||
allocationNotificationForm' :: NonNull (Map AllocationId (Maybe Bool)) -> AForm Handler (Map AllocationId (Maybe Bool))
|
||||
allocationNotificationForm' (toNullable -> allocs) = funcForm' . flip imap allocs $ \allocId mPrev -> wFormToAForm $ do
|
||||
let _AllocNotify :: Iso' (Maybe Bool) AllocationNotificationState
|
||||
_AllocNotify = iso toNotify fromNotify
|
||||
where fromNotify = \case
|
||||
AllocNotifyNewCourseDefault -> Nothing
|
||||
AllocNotifyNewCourseForceOn -> Just True
|
||||
AllocNotifyNewCourseForceOff -> Just False
|
||||
toNotify = \case
|
||||
Nothing -> AllocNotifyNewCourseDefault
|
||||
Just True -> AllocNotifyNewCourseForceOn
|
||||
Just False -> AllocNotifyNewCourseForceOff
|
||||
|
||||
Allocation{..} <- liftHandler . runDB $ getJust allocId
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
let allocDesc = [st|#{mr (ShortTermIdentifier $ unTermKey allocationTerm)}, #{unSchoolKey allocationSchool}, #{allocationName}|]
|
||||
cID <- encrypt allocId :: _ CryptoUUIDAllocation
|
||||
|
||||
fmap (review _AllocNotify) <$> wpopt (radioGroupField Nothing optionsFinite) (fsl allocDesc & addName [st|alloc-notify__#{toPathPiece cID}|]) (Just $ mPrev ^. _AllocNotify)
|
||||
where funcForm' forms = funcForm forms (fslI MsgFormAllocationNotifications & setTooltip MsgFormAllocationNotificationsTip) False
|
||||
|
||||
|
||||
examOfficeForm :: Maybe ExamOfficeSettings -> AForm Handler ExamOfficeSettings
|
||||
examOfficeForm template = wFormToAForm $ do
|
||||
@ -506,7 +415,6 @@ serveProfileR (uid, user@User{..}) = do
|
||||
return $ school E.^. SchoolId
|
||||
userExamOfficeLabels <- selectList [ ExamOfficeLabelUser ==. uid ] []
|
||||
return (userSchools, userExamOfficeLabels)
|
||||
allocs <- runDB $ getAllocationNotifications uid
|
||||
let settingsTemplate = Just SettingsForm
|
||||
{ stgDisplayName = userDisplayName
|
||||
, stgDisplayEmail = userDisplayEmail
|
||||
@ -529,7 +437,6 @@ serveProfileR (uid, user@User{..}) = do
|
||||
, eosettingsGetLabels = userExamOfficeGetLabels
|
||||
, eosettingsLabels = flip foldMap userExamOfficeLabels $ \(Entity eolid ExamOfficeLabel{..}) -> Map.singleton (Right eolid) (examOfficeLabelName,examOfficeLabelStatus,examOfficeLabelPriority)
|
||||
}
|
||||
, stgAllocationNotificationSettings = allocs
|
||||
}
|
||||
((res,formWidget), formEnctype) <- runFormPost . validateForm (validateSettings user) . identifyForm ProfileSettings $ makeSettingForm settingsTemplate
|
||||
|
||||
@ -553,7 +460,6 @@ serveProfileR (uid, user@User{..}) = do
|
||||
, UserExamOfficeGetSynced =. (stgExamOfficeSettings & eosettingsGetSynced)
|
||||
, UserExamOfficeGetLabels =. (stgExamOfficeSettings & eosettingsGetLabels)
|
||||
] ++ [ UserDisplayEmail =. stgDisplayEmail | userDisplayEmail == stgDisplayEmail ]
|
||||
setAllocationNotifications uid stgAllocationNotificationSettings
|
||||
updateFavourites Nothing
|
||||
when (stgDisplayEmail /= userDisplayEmail) $ do
|
||||
queueDBJob $ JobChangeUserDisplayEmail uid stgDisplayEmail
|
||||
@ -1098,13 +1004,11 @@ getUserNotificationR, postUserNotificationR :: CryptoUUIDUser -> Handler Html
|
||||
getUserNotificationR = postUserNotificationR
|
||||
postUserNotificationR cID = do
|
||||
uid <- decrypt cID
|
||||
(User{userNotificationSettings, userDisplayName}, allocs) <- runDB $ (,)
|
||||
<$> get404 uid
|
||||
<*> getAllocationNotifications uid
|
||||
User{userNotificationSettings, userDisplayName} <- runDB $
|
||||
get404 uid
|
||||
|
||||
((nsRes, nsInnerWdgt), nsEnc) <- runFormPost . formEmbedBearerPost . renderAForm FormStandard $ (,)
|
||||
<$> notificationForm (Just userNotificationSettings)
|
||||
<*> allocationNotificationForm (Just allocs)
|
||||
((nsRes, nsInnerWdgt), nsEnc) <- runFormPost . formEmbedBearerPost . renderAForm FormStandard $
|
||||
notificationForm (Just userNotificationSettings)
|
||||
mBearer <- askBearer
|
||||
isModal <- hasCustomHeader HeaderIsModal
|
||||
let formWidget = wrapForm nsInnerWdgt def
|
||||
@ -1113,10 +1017,9 @@ postUserNotificationR cID = do
|
||||
, formAttrs = [ asyncSubmitAttr | isModal ]
|
||||
}
|
||||
|
||||
formResultModal nsRes (UserNotificationR cID, [ (toPathPiece GetBearer, toPathPiece bearer) | Just bearer <- pure mBearer ]) $ \(ns, ans) -> do
|
||||
formResultModal nsRes (UserNotificationR cID, [ (toPathPiece GetBearer, toPathPiece bearer) | Just bearer <- pure mBearer ]) $ \ns -> do
|
||||
lift . runDB $ do
|
||||
update uid [ UserNotificationSettings =. ns ]
|
||||
setAllocationNotifications uid ans
|
||||
tell . pure =<< messageI Success MsgNotificationSettingsUpdate
|
||||
|
||||
siteLayoutMsg (MsgNotificationSettingsHeading userDisplayName) $ do
|
||||
|
||||
@ -44,12 +44,9 @@ getTermShowR = do
|
||||
table <- runDB $
|
||||
let termDBTable = DBTable{..}
|
||||
where dbtSQLQuery term = return (term, courseCount, isActive)
|
||||
where courseCount = E.subSelectCount . E.from $ \(course `E.LeftOuterJoin` allocation) -> do
|
||||
E.on . E.exists . E.from $ \allocationCourse ->
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.&&. E.just (allocationCourse E.^. AllocationCourseAllocation) E.==. allocation E.?. AllocationId
|
||||
where courseCount = E.subSelectCount . E.from $ \course ->
|
||||
E.where_ $ term E.^. TermId E.==. course E.^. CourseTerm
|
||||
E.&&. mayViewCourse muid ata now course (allocation E.?. AllocationId)
|
||||
E.&&. mayViewCourse muid ata now course
|
||||
isActive = termIsActiveE (E.val now) (E.val muid) (term E.^. TermId)
|
||||
dbtRowKey = (E.^. TermId)
|
||||
dbtProj = dbrOutput <$> dbtProjId
|
||||
|
||||
@ -1,307 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Handler.Utils.Allocation
|
||||
( allocationStarted, allocationNotifyNewCourses
|
||||
, ordinalPriorities
|
||||
, sinkAllocationPriorities
|
||||
, MatchingLogRun(..)
|
||||
, computeAllocation
|
||||
-- , doAllocation -- Use `storeAllocationResult`
|
||||
, ppMatchingLog
|
||||
, storeAllocationResult
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import qualified Data.Map.Strict as Map
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import Control.Monad.Trans.State (execStateT)
|
||||
import qualified Control.Monad.State.Class as State (get, modify')
|
||||
|
||||
import Data.List (genericLength)
|
||||
import qualified Data.Vector as Vector
|
||||
import Data.Vector.Lens (vector)
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import qualified Data.Binary as Binary
|
||||
import Crypto.Hash.Algorithms (SHAKE256)
|
||||
import Crypto.Random (drgNewSeed, seedFromBinary)
|
||||
import Crypto.Error (onCryptoFailure)
|
||||
|
||||
import Utils.Allocation
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
import Data.Generics.Product.Param
|
||||
|
||||
import qualified Crypto.Hash as Crypto
|
||||
|
||||
import Language.Haskell.TH (nameBase)
|
||||
|
||||
|
||||
data MatchingExcludedReason
|
||||
= MatchingExcludedParticipationExisted
|
||||
| MatchingExcludedParticipationExists
|
||||
| MatchingExcludedVeto
|
||||
| MatchingExcludedLecturer
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
deriving anyclass (Universe, Finite, NFData)
|
||||
|
||||
nullaryPathPiece ''MatchingExcludedReason $ camelToPathPiece' 2
|
||||
pathPieceJSON ''MatchingExcludedReason
|
||||
|
||||
data MatchingLogRun = MatchingLogRun
|
||||
{ matchingLogRunCourseRestriction :: Maybe (Set CourseId)
|
||||
, matchingLogRunCoursesExcluded :: Set CourseId
|
||||
, matchingLogMatchingsExcluded :: Map (UserId, CourseId) (NonNull (Set MatchingExcludedReason))
|
||||
, matchingLogRunLog :: Seq (MatchingLog UserId CourseId Natural)
|
||||
} deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
deriving anyclass (NFData)
|
||||
|
||||
deriveJSON defaultOptions
|
||||
{ fieldLabelModifier = camelToPathPiece' 3
|
||||
} ''MatchingLogRun
|
||||
|
||||
|
||||
allocationStarted :: AllocationId -> DB (Maybe UTCTime)
|
||||
-- ^ Time the first allocation was made
|
||||
allocationStarted allocId = fmap (E.unValue <=< listToMaybe) . E.select . E.from $ \allocationMatching -> do
|
||||
E.where_ $ allocationMatching E.^. AllocationMatchingAllocation E.==. E.val allocId
|
||||
return . E.min_ $ allocationMatching E.^. AllocationMatchingTime
|
||||
|
||||
allocationNotifyNewCourses :: E.SqlExpr (E.Value AllocationId)
|
||||
-> E.SqlExpr (E.Value UserId)
|
||||
-> E.SqlExpr (E.Value Bool)
|
||||
allocationNotifyNewCourses allocId uid = ( hasOverride True E.||. hasApplication E.||. isParticipant )
|
||||
E.&&. E.not_ (hasOverride False)
|
||||
where
|
||||
hasOverride overrideVal = E.exists . E.from $ \allocationNotificationSetting ->
|
||||
E.where_ $ allocationNotificationSetting E.^. AllocationNotificationSettingUser E.==. uid
|
||||
E.&&. allocationNotificationSetting E.^. AllocationNotificationSettingAllocation E.==. allocId
|
||||
E.&&. allocationNotificationSetting E.^. AllocationNotificationSettingIsOptOut E.==. E.val (not overrideVal)
|
||||
|
||||
hasApplication = E.exists . E.from $ \application ->
|
||||
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just allocId
|
||||
E.&&. application E.^. CourseApplicationUser E.==. uid
|
||||
|
||||
isParticipant = E.exists . E.from $ \allocationUser ->
|
||||
E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. allocId
|
||||
E.&&. allocationUser E.^. AllocationUserUser E.==. uid
|
||||
|
||||
|
||||
ordinalPriorities :: Monad m => ConduitT UserMatriculation (Map UserMatriculation AllocationPriority) m ()
|
||||
ordinalPriorities = evalStateC 0 . C.mapM $ \matr -> singletonMap matr <$> (AllocationPriorityOrdinal <$> State.get <* State.modify' succ)
|
||||
|
||||
sinkAllocationPriorities :: AllocationId
|
||||
-> ConduitT (Map UserMatriculation AllocationPriority) Void DB Int64
|
||||
sinkAllocationPriorities allocId = fmap getSum . C.foldMapM . ifoldMapM $ \matr prio ->
|
||||
fmap Sum . E.updateCount $ \allocationUser -> do
|
||||
E.set allocationUser [ AllocationUserPriority E.=. E.val (Just prio) ]
|
||||
E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. E.val allocId
|
||||
E.where_ . E.exists . E.from $ \user ->
|
||||
E.where_ $ user E.^. UserId E.==. allocationUser E.^. AllocationUserUser
|
||||
E.&&. user E.^. UserMatrikelnummer E.==. E.val (Just matr)
|
||||
|
||||
|
||||
computeAllocation :: Entity Allocation
|
||||
-> Maybe (Set CourseId) -- ^ Optionally restrict allocation to only consider the given courses
|
||||
-> DB ( AllocationFingerprint
|
||||
, Set CourseId
|
||||
, Set (UserId, CourseId)
|
||||
, Seq MatchingLogRun
|
||||
)
|
||||
computeAllocation (Entity allocId Allocation{allocationMatchingSeed}) cRestr = do
|
||||
allocations <- selectList [ CourseParticipantAllocated ==. Just allocId, CourseParticipantState ==. CourseParticipantActive ] []
|
||||
let allocations' = allocations
|
||||
& map ((, Sum 1) . courseParticipantUser . entityVal)
|
||||
& Map.fromListWith (<>)
|
||||
|
||||
deregistrations <- E.select . E.from $ \(allocationDeregister `E.InnerJoin` courseParticipant) -> do
|
||||
E.on $ courseParticipant E.^. CourseParticipantUser E.==. allocationDeregister E.^. AllocationDeregisterUser
|
||||
E.&&. E.just (courseParticipant E.^. CourseParticipantCourse) E.==. allocationDeregister E.^. AllocationDeregisterCourse
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantState E.!=. E.val CourseParticipantActive
|
||||
E.&&. courseParticipant E.^. CourseParticipantAllocated E.==. E.just (E.val allocId)
|
||||
return $ allocationDeregister E.^. AllocationDeregisterUser
|
||||
let deregistrations' = deregistrations
|
||||
& map ((, Sum 1) . E.unValue)
|
||||
& Map.fromListWith (<>)
|
||||
|
||||
users' <- selectList [ AllocationUserAllocation ==. allocId ] []
|
||||
let users'' = users'
|
||||
& mapMaybe ( runMaybeT $ do
|
||||
user <- lift $ allocationUserUser . entityVal
|
||||
totalCourses <- lift $ allocationUserTotalCourses . entityVal
|
||||
priority <- MaybeT $ allocationUserPriority . entityVal
|
||||
|
||||
let Sum allocated = Map.findWithDefault 0 user allocations' <> Map.findWithDefault 0 user deregistrations'
|
||||
|
||||
guard $ totalCourses > allocated
|
||||
|
||||
return (user, ((allocated, totalCourses - allocated), priority))
|
||||
)
|
||||
& Map.fromList
|
||||
cloneCounts = Map.map (views _1 $ bimap fromIntegral fromIntegral) users''
|
||||
allocationPrio = view _2 . (Map.!) users''
|
||||
|
||||
courses' <- E.select . E.from $ \(allocationCourse `E.InnerJoin` course) -> do
|
||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val allocId
|
||||
|
||||
let participants = E.subSelectCount . E.from $ \participant -> do
|
||||
E.where_ $ participant E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
||||
E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
E.where_ . E.not_ . E.exists . E.from $ \lecturer ->
|
||||
E.where_ $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
|
||||
E.&&. lecturer E.^. LecturerUser E.==. participant E.^. CourseParticipantUser
|
||||
|
||||
whenIsJust cRestr $ \restrSet ->
|
||||
E.where_ $ course E.^. CourseId `E.in_` E.valList (Set.toList restrSet)
|
||||
|
||||
return ( allocationCourse
|
||||
, E.maybe E.nothing (\c -> E.just $ c E.-. participants) (course E.^. CourseCapacity)
|
||||
, allocationCourse E.^. AllocationCourseMinCapacity E.-. participants
|
||||
)
|
||||
let capacities = Map.filter (maybe True (> 0)) . Map.fromList $ (view (_1 . _entityVal . _allocationCourseCourse) &&& view (_2 . _Value)) <$> courses'
|
||||
eligibleCourses = setOf (folded . _1 . _entityVal . _allocationCourseCourse) courses'
|
||||
|
||||
applications' <- selectList [ CourseApplicationAllocation ==. Just allocId ] []
|
||||
excludedMatchings <- flip execStateT mempty . forM_ applications' $ \(Entity _ CourseApplication{..}) -> do
|
||||
let
|
||||
tellExcluded :: MatchingExcludedReason -> StateT _ _ ()
|
||||
tellExcluded reason = State.modify' $ Map.insertWith (<>) (courseApplicationUser, courseApplicationCourse) (opoint reason :: NonNull (Set MatchingExcludedReason))
|
||||
|
||||
when (courseApplicationRatingVeto || maybe False not (courseApplicationRatingPoints ^? _Just . passingGrade . _Wrapped)) $
|
||||
tellExcluded MatchingExcludedVeto
|
||||
|
||||
allocStarted <- lift $ allocationStarted allocId
|
||||
whenIsJust allocStarted $ \allocStarted' -> do
|
||||
let partDeleted = lift $ or2M
|
||||
(exists [ TransactionLogInfo ==. toJSON (TransactionCourseParticipantDeleted courseApplicationCourse courseApplicationUser), TransactionLogTime >=. allocStarted' ])
|
||||
(exists [ CourseParticipantCourse ==. courseApplicationCourse, CourseParticipantUser ==. courseApplicationUser, CourseParticipantState !=. CourseParticipantActive ])
|
||||
whenM partDeleted $
|
||||
tellExcluded MatchingExcludedParticipationExisted
|
||||
|
||||
let partExists :: StateT _ DB Bool
|
||||
partExists = lift $ exists [ CourseParticipantCourse ==. courseApplicationCourse, CourseParticipantUser ==. courseApplicationUser, CourseParticipantState ==. CourseParticipantActive ]
|
||||
whenM partExists $
|
||||
tellExcluded MatchingExcludedParticipationExists
|
||||
|
||||
let lecturerExists = lift $ exists [ LecturerCourse ==. courseApplicationCourse, LecturerUser ==. courseApplicationUser ]
|
||||
whenM lecturerExists $
|
||||
tellExcluded MatchingExcludedLecturer
|
||||
let applications'' = applications'
|
||||
& map entityVal
|
||||
& filter (\CourseApplication{..} -> Map.notMember (courseApplicationUser, courseApplicationCourse) excludedMatchings)
|
||||
let preferences = Map.fromList $ do
|
||||
CourseApplication{..} <- applications''
|
||||
guard $ Map.member courseApplicationCourse capacities
|
||||
return ((courseApplicationUser, courseApplicationCourse), (courseApplicationAllocationPriority, courseApplicationRatingPoints))
|
||||
|
||||
gradeScale <- getsYesod $ view _appAllocationGradeScale
|
||||
gradeOrdinalProportion <- getsYesod $ view _appAllocationGradeOrdinalProportion
|
||||
let ordinalUsers = getSum . flip foldMap users'' $ \(_, prio) -> case prio of
|
||||
AllocationPriorityOrdinal{} -> Sum 1
|
||||
_other -> mempty
|
||||
gradeOrdinalPlaces :: Natural
|
||||
gradeOrdinalPlaces = round . abs $ ordinalUsers * gradeOrdinalProportion
|
||||
|
||||
let centralNudge user cloneIndex grade = case allocationPrio user of
|
||||
AllocationPriorityNumeric{..}
|
||||
-> let allocationPriorities' = under vector (sortOn Down) allocationPriorities
|
||||
minPrio | Vector.null allocationPriorities' = 0
|
||||
| otherwise = Vector.last allocationPriorities'
|
||||
in AllocationPriorityComparisonNumeric . withNumericGrade . fromInteger . fromMaybe minPrio $ allocationPriorities Vector.!? fromIntegral cloneIndex
|
||||
AllocationPriorityOrdinal{..}
|
||||
| gradeOrdinalPlaces > 0
|
||||
-> let allocationOrdinal' = gradeScale / fromIntegral gradeOrdinalPlaces * fromIntegral allocationOrdinal
|
||||
in AllocationPriorityComparisonOrdinal (Down cloneIndex) $ withNumericGrade allocationOrdinal'
|
||||
AllocationPriorityOrdinal{..}
|
||||
-> AllocationPriorityComparisonOrdinal (Down cloneIndex) $ fromIntegral allocationOrdinal
|
||||
where
|
||||
withNumericGrade :: Rational -> Rational
|
||||
withNumericGrade
|
||||
| Just grade' <- grade
|
||||
= let numberGrade' = maybe (error "non-passing grade") fromIntegral (elemIndex grade' passingGrades) / pred (genericLength passingGrades)
|
||||
passingGrades = sort $ filter (view $ passingGrade . _Wrapped) universeF
|
||||
numericGrade = -gradeScale + numberGrade' * 2 * gradeScale
|
||||
in (+) numericGrade
|
||||
| otherwise
|
||||
= id
|
||||
|
||||
let
|
||||
inputs = Binary.encode (users'', capacities, preferences, gradeScale, gradeOrdinalPlaces)
|
||||
|
||||
fingerprint :: AllocationFingerprint
|
||||
fingerprint = Crypto.hashlazy inputs
|
||||
|
||||
g = onCryptoFailure (\_ -> error "Could not create DRG") id . fmap drgNewSeed . seedFromBinary $ kmaclazy @(SHAKE256 320) (encodeUtf8 . (pack :: String -> Text) $ nameBase 'computeAllocation) allocationMatchingSeed inputs
|
||||
|
||||
let
|
||||
doAllocationWithout :: Set CourseId -> Writer (Seq (MatchingLog UserId CourseId Natural)) (Set (UserId, CourseId))
|
||||
doAllocationWithout cs = computeMatchingLog g cloneCounts capacities' preferences' centralNudge
|
||||
where
|
||||
capacities' = Map.filterWithKey (\ c _ -> Set.notMember c cs) capacities
|
||||
preferences' = Map.filterWithKey (\(_, c) _ -> Set.notMember c cs) preferences
|
||||
|
||||
allocationLoop :: Set CourseId -> Writer (Seq MatchingLogRun) (Set (UserId, CourseId))
|
||||
allocationLoop cs = do
|
||||
allocs <- mapWriter (over _2 $ pure . MatchingLogRun cRestr cs excludedMatchings) $ doAllocationWithout cs
|
||||
let
|
||||
belowMin = catMaybes . flip map courses' $ \(Entity _ AllocationCourse{..}, _, E.Value minCap) -> do
|
||||
guard . not $ Set.member allocationCourseCourse cs
|
||||
guard $ Set.size (Set.filter (\(_, c) -> c == allocationCourseCourse) allocs) < minCap
|
||||
return allocationCourseCourse
|
||||
if
|
||||
| not $ null belowMin -> allocationLoop $ cs <> Set.fromList belowMin
|
||||
| otherwise -> return allocs
|
||||
|
||||
return . (\(ms, mLog) -> (fingerprint, eligibleCourses, ms, mLog)) $!! runWriter (allocationLoop Set.empty)
|
||||
|
||||
|
||||
doAllocation :: AllocationId
|
||||
-> UTCTime
|
||||
-> Set (UserId, CourseId)
|
||||
-> DB ()
|
||||
doAllocation allocId now regs =
|
||||
forM_ regs $ \(uid, cid) -> do
|
||||
void $ upsert
|
||||
(CourseParticipant cid uid now (Just allocId) CourseParticipantActive)
|
||||
[ CourseParticipantRegistration =. now
|
||||
, CourseParticipantAllocated =. Just allocId
|
||||
, CourseParticipantState =. CourseParticipantActive
|
||||
]
|
||||
audit $ TransactionCourseParticipantEdit cid uid
|
||||
|
||||
ppMatchingLog :: Seq MatchingLogRun -> Text
|
||||
ppMatchingLog = unlines . map prettyRun . otoList
|
||||
where
|
||||
prettyRun MatchingLogRun{..} = unlines
|
||||
[ "----- STARTING RUN -----"
|
||||
, "Course restriction: " <> tshow (Set.toAscList <$> matchingLogRunCourseRestriction)
|
||||
, "Courses excluded: " <> tshow (Set.toAscList matchingLogRunCoursesExcluded)
|
||||
, "Matchings excluded (user, course): "
|
||||
, unlines . map (" " <>) . flip ifoldMap matchingLogMatchingsExcluded $ \(uid, cid) (otoList -> reasons) -> pure $
|
||||
"(" <> tshow (fromSqlKey uid) <> ", " <> tshow (fromSqlKey cid) <> ") " <> intercalate ", " (map tshow reasons) :: [Text]
|
||||
, "------------------------"
|
||||
, unlines . map (tshow . pretty) $ otoList matchingLogRunLog
|
||||
, "------ RUN ENDED -------"
|
||||
]
|
||||
|
||||
pretty :: MatchingLog UserId CourseId Natural -> MatchingLog Int64 Int64 Natural
|
||||
pretty = over (param @1) fromSqlKey
|
||||
. over (param @2) fromSqlKey
|
||||
|
||||
storeAllocationResult :: AllocationId
|
||||
-> UTCTime
|
||||
-> (AllocationFingerprint, Set (UserId, CourseId), Seq MatchingLogRun)
|
||||
-> DB ()
|
||||
storeAllocationResult allocId now (allocFp, allocMatchings, ppMatchingLog -> allocLog) = do
|
||||
FileReference{..} <- sinkFile $ File "matchings.log" (Just . yield $ encodeUtf8 allocLog) now
|
||||
insert_ . AllocationMatching allocId allocFp now $ fromMaybe (error "allocation result stored without fileReferenceContent") fileReferenceContent
|
||||
|
||||
doAllocation allocId now allocMatchings
|
||||
@ -35,9 +35,6 @@ import qualified Data.Char as Char
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
-- import Yesod.Core
|
||||
import qualified Data.Text as T
|
||||
-- import Yesod.Form.Types
|
||||
import Yesod.Form.Bootstrap3
|
||||
|
||||
import Handler.Utils.Zip
|
||||
@ -54,8 +51,6 @@ import qualified Data.Sequence as Seq
|
||||
import Data.Map ((!), (!?))
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import qualified Data.Vector as Vector
|
||||
|
||||
import qualified Data.HashMap.Lazy as HashMap
|
||||
|
||||
import Control.Monad.Error.Class (MonadError(..))
|
||||
@ -63,6 +58,8 @@ import Control.Monad.Error.Class (MonadError(..))
|
||||
import Data.Aeson (eitherDecodeStrict')
|
||||
import Data.Aeson.Text (encodeToLazyText)
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
import qualified Text.Email.Validate as Email
|
||||
|
||||
import Data.Text.Lens (unpacked)
|
||||
@ -2317,33 +2314,6 @@ examModeForm mPrev = examMode
|
||||
examRequiredEquipmentFromEither (Left c) = ExamRequiredEquipmentCustom c
|
||||
|
||||
|
||||
data AllocationPriority' = AllocationPriorityNumeric' | AllocationPriorityOrdinal'
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
deriving anyclass (Universe, Finite)
|
||||
nullaryPathPiece ''AllocationPriority' $ camelToPathPiece' 2 . dropSuffix "'"
|
||||
embedRenderMessage ''UniWorX ''AllocationPriority' id
|
||||
|
||||
classifyAllocationPriority :: AllocationPriority -> AllocationPriority'
|
||||
classifyAllocationPriority = \case
|
||||
AllocationPriorityNumeric{} -> AllocationPriorityNumeric'
|
||||
AllocationPriorityOrdinal{} -> AllocationPriorityOrdinal'
|
||||
|
||||
allocationPriorityForm :: FieldSettings UniWorX
|
||||
-> Maybe AllocationPriority
|
||||
-> AForm Handler AllocationPriority
|
||||
allocationPriorityForm fs mPrev = multiActionA opts fs $ classifyAllocationPriority <$> mPrev
|
||||
where
|
||||
opts = flip Map.fromSet (Set.fromList universeF) $ \case
|
||||
AllocationPriorityNumeric' -> AllocationPriorityNumeric <$> apreq (checkMap toInts fromInts textField) (fslI MsgAllocationPriorityNumericValues & setTooltip MsgAllocationPriorityNumericValuesTip) (mPrev ^? _Just . _AllocationPriorityNumeric)
|
||||
AllocationPriorityOrdinal' -> AllocationPriorityOrdinal <$> apreq (natFieldI MsgAllocationPriorityOrdinalValueNegative) (fslI MsgAllocationPriorityOrdinalValue & setTooltip MsgAllocationPriorityOrdinalValueTip) (mPrev ^? _Just . _AllocationPriorityOrdinal)
|
||||
|
||||
toInts t = fmap Vector.fromList . runExcept $ do
|
||||
let ts = filter (not . Text.null) . map Text.strip $ Text.splitOn "," t
|
||||
whenExceptT (null ts) MsgAllocationPriorityNumericNoValues
|
||||
forM ts $ \t' -> maybeExceptT (MsgAllocationPriorityNumericNoParse t') . return $ readMay t'
|
||||
fromInts = Text.intercalate ", " . map tshow . Vector.toList
|
||||
|
||||
|
||||
roomReferenceFormOpt :: FieldSettings UniWorX
|
||||
-> Maybe (Maybe RoomReference)
|
||||
-> AForm Handler (Maybe RoomReference)
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
@ -12,7 +12,6 @@ module Handler.Utils.StudyFeatures
|
||||
, isCourseStudyFeature, courseUserStudyFeatures
|
||||
, isExternalExamStudyFeature, externalExamUserStudyFeatures
|
||||
, isTermStudyFeature
|
||||
, isAllocationStudyFeature, allocationUserStudyFeatures
|
||||
) where
|
||||
|
||||
import Import.NoFoundation
|
||||
@ -193,24 +192,3 @@ externalExamUserStudyFeatures eeId uid = do
|
||||
|
||||
isTermStudyFeature :: E.SqlExpr (Entity Term) -> E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Bool)
|
||||
isTermStudyFeature = isRelevantStudyFeatureCached TermId
|
||||
|
||||
|
||||
isAllocationStudyFeature :: E.SqlExpr (Entity Allocation) -> E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Bool)
|
||||
isAllocationStudyFeature = isRelevantStudyFeatureCached AllocationTerm
|
||||
|
||||
allocationUserStudyFeatures :: MonadIO m => AllocationId -> UserId -> SqlPersistT m UserTableStudyFeatures
|
||||
allocationUserStudyFeatures aId uid = do
|
||||
feats <- E.select . E.from $ \(allocation `E.InnerJoin` studyFeatures `E.InnerJoin` terms `E.InnerJoin` degree) -> do
|
||||
E.on $ degree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree
|
||||
E.on $ terms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField
|
||||
E.on $ isAllocationStudyFeature allocation studyFeatures
|
||||
E.where_ $ allocation E.^. AllocationId E.==. E.val aId
|
||||
E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
|
||||
return (terms, degree, studyFeatures)
|
||||
return . UserTableStudyFeatures . Set.fromList . flip map feats $
|
||||
\(Entity _ StudyTerms{..}, Entity _ StudyDegree{..}, Entity _ StudyFeatures{..}) -> UserTableStudyFeature
|
||||
{ userTableField = fromMaybe (tshow studyTermsKey) studyTermsName
|
||||
, userTableDegree = fromMaybe (tshow studyDegreeKey) studyDegreeName
|
||||
, userTableSemester = studyFeaturesSemester
|
||||
, userTableFieldType = studyFeaturesType
|
||||
}
|
||||
|
||||
@ -8,19 +8,8 @@ module Handler.Utils.Table.Columns where
|
||||
|
||||
import Import hiding (link)
|
||||
|
||||
-- import Data.CaseInsensitive (CI)
|
||||
-- import qualified Data.CaseInsensitive as CI
|
||||
|
||||
-- import Data.Monoid (Any(..))
|
||||
-- import Control.Monad.Writer.Class (MonadWriter(..))
|
||||
-- import Control.Monad.Trans.Writer (WriterT)
|
||||
|
||||
-- import Text.Blaze (ToMarkup(..))
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.Utils as E hiding ((->.))
|
||||
import qualified Database.Esqueleto.PostgreSQL.JSON as E (JSONBExpr, (->.))
|
||||
import qualified Database.Esqueleto.Internal.Internal as IE
|
||||
import Database.Esqueleto.Utils (mkExactFilter, mkExactFilterWith, mkContainsFilter, mkContainsFilterWith, anyFilter)
|
||||
|
||||
import Handler.Utils.Table.Cells
|
||||
@ -53,6 +42,7 @@ import qualified Data.Set as Set
|
||||
-- * sortXYZ : sorting definitions for these columns
|
||||
-- * fltrXYZ : filter definitions for these columns
|
||||
-- * additional helper, such as default sorting
|
||||
--------------------------------
|
||||
|
||||
type OpticColonnade focus
|
||||
= forall m x r' h.
|
||||
@ -141,69 +131,6 @@ fltrSchool querySsh = singletonMap "school" . FilterColumn $ mkExactFilter (view
|
||||
fltrSchoolUI :: DBFilterUI
|
||||
fltrSchoolUI mPrev = prismAForm (singletonFilter "school" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift schoolField) (fslI MsgTableSchool)
|
||||
|
||||
-----------------
|
||||
-- Allocations --
|
||||
-----------------
|
||||
|
||||
colAllocationName :: OpticColonnade AllocationName
|
||||
colAllocationName resultName = Colonnade.singleton (fromSortable header) body
|
||||
where
|
||||
header = Sortable (Just "allocation") (i18nCell MsgAllocationName)
|
||||
body = i18nCell . view resultName
|
||||
|
||||
sortAllocationName :: OpticSortColumn AllocationName
|
||||
sortAllocationName queryName = singletonMap "allocation" . SortColumn $ view queryName
|
||||
|
||||
fltrAllocation :: forall allocation t shorthand name.
|
||||
( E.SqlProject Allocation AllocationShorthand allocation shorthand
|
||||
, E.SqlProject Allocation AllocationName allocation name
|
||||
, E.SqlString name, E.SqlString shorthand
|
||||
)
|
||||
=> OpticFilterColumn' t (Set (CI Text)) (E.SqlExpr allocation)
|
||||
fltrAllocation query = singletonMap "allocation" . FilterColumn $ anyFilter
|
||||
[ mkContainsFilterWith unSqlProject' $ views query (`E.sqlProject` AllocationShorthand) :: t -> Set (CI Text) -> E.SqlExpr (E.Value Bool)
|
||||
, mkContainsFilterWith unSqlProject' $ views query (`E.sqlProject` AllocationName)
|
||||
]
|
||||
where
|
||||
unSqlProject' :: E.SqlProject Allocation value allocation value' => value -> value'
|
||||
unSqlProject' = E.unSqlProject (Proxy @Allocation) (Proxy @allocation)
|
||||
|
||||
fltrAllocationUI :: DBFilterUI
|
||||
fltrAllocationUI mPrev = prismAForm (singletonFilter "allocation" . maybePrism _PathPiece) mPrev $ aopt (ciField :: Field _ AllocationName) (fslI MsgAllocation)
|
||||
|
||||
|
||||
colAllocationShorthand :: OpticColonnade AllocationShorthand
|
||||
colAllocationShorthand resultShort = Colonnade.singleton (fromSortable header) body
|
||||
where
|
||||
header = Sortable (Just "allocation-short") (i18nCell MsgAllocation)
|
||||
body = i18nCell . view resultShort
|
||||
|
||||
sortAllocationShorthand :: forall shorthand. PersistField shorthand => OpticSortColumn shorthand
|
||||
sortAllocationShorthand queryShorthand = singletonMap "allocation-short" . SortColumn $ view queryShorthand
|
||||
|
||||
|
||||
fltrAllocationActive :: UTCTime -- ^ current time
|
||||
-> OpticFilterColumn' t (Last Bool) (E.SqlExpr (E.Entity Allocation))
|
||||
fltrAllocationActive cTime queryAllocation = singletonMap "active" . FilterColumn $ \(view queryAllocation -> allocation) (Last criterion)
|
||||
-> maybe (const E.true) ((E.==.) . E.val) criterion $ E.or
|
||||
[ staffRegisterActive allocation
|
||||
, staffAllocationActive allocation
|
||||
, registerActive allocation
|
||||
]
|
||||
where
|
||||
staffRegisterActive allocation
|
||||
= E.maybe E.false (\f -> f E.<=. E.val cTime) (allocation E.^. AllocationStaffRegisterFrom)
|
||||
E.&&. E.maybe E.true (\t -> E.val cTime E.<=. t) (allocation E.^. AllocationStaffRegisterTo)
|
||||
staffAllocationActive allocation
|
||||
= E.maybe E.false (\f -> f E.<=. E.val cTime) (allocation E.^. AllocationStaffAllocationFrom)
|
||||
E.&&. E.maybe E.true (\t -> E.val cTime E.<=. t) (allocation E.^. AllocationStaffAllocationTo)
|
||||
registerActive allocation
|
||||
= E.maybe E.false (\f -> f E.<=. E.val cTime) (allocation E.^. AllocationRegisterFrom)
|
||||
E.&&. E.maybe E.true (\t -> E.val cTime E.<=. t) (allocation E.^. AllocationRegisterTo)
|
||||
|
||||
fltrAllocationActiveUI :: DBFilterUI
|
||||
fltrAllocationActiveUI mPrev = prismAForm (singletonFilter "active" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgAllocationActive)
|
||||
|
||||
|
||||
-----------
|
||||
-- Exams --
|
||||
@ -309,100 +236,10 @@ colCourseName resultName = Colonnade.singleton (fromSortable header) body
|
||||
sortCourseName :: OpticSortColumn CourseName
|
||||
sortCourseName queryName = singletonMap "course-name" . SortColumn $ view queryName
|
||||
|
||||
-------------------------
|
||||
-- Course Applications --
|
||||
-------------------------
|
||||
|
||||
colApplicationId :: OpticColonnade CourseApplicationId
|
||||
colApplicationId resultId = Colonnade.singleton (fromSortable header) body
|
||||
where
|
||||
header = Sortable Nothing $ i18nCell MsgCourseApplicationId
|
||||
body = views resultId $ \aId -> cell $ toWidget . toMarkup =<< (encrypt :: CourseApplicationId -> WidgetFor UniWorX CryptoFileNameCourseApplication) aId
|
||||
|
||||
colApplicationRatingPoints :: OpticColonnade (Maybe ExamGrade)
|
||||
colApplicationRatingPoints resultPoints = Colonnade.singleton (fromSortable header) body
|
||||
where
|
||||
header = Sortable (Just "points") (i18nCell MsgCourseApplicationRatingPoints)
|
||||
body = views resultPoints $ maybe mempty i18nCell
|
||||
|
||||
sortApplicationRatingPoints :: OpticSortColumn (Maybe ExamGrade)
|
||||
sortApplicationRatingPoints queryPoints = singletonMap "points" . SortColumn $ view queryPoints
|
||||
|
||||
fltrApplicationRatingPoints :: OpticFilterColumn t (Maybe ExamGrade)
|
||||
fltrApplicationRatingPoints queryPoints = singletonMap "points" . FilterColumn . mkExactFilter $ view queryPoints
|
||||
|
||||
fltrApplicationRatingPointsUI :: DBFilterUI
|
||||
fltrApplicationRatingPointsUI mPrev = prismAForm (singletonFilter "points" . maybePrism _PathPiece) mPrev $ aopt examGradeField (fslI MsgCourseApplicationRatingPoints)
|
||||
|
||||
colApplicationVeto :: OpticColonnade Bool
|
||||
colApplicationVeto resultVeto = Colonnade.singleton (fromSortable header) body
|
||||
where
|
||||
header = Sortable (Just "veto") (i18nCell MsgCourseApplicationVeto)
|
||||
body = views resultVeto $ bool mempty (iconCell IconApplicationVeto)
|
||||
|
||||
sortApplicationVeto :: OpticSortColumn Bool
|
||||
sortApplicationVeto queryVeto = singletonMap "veto" . SortColumn $ view queryVeto
|
||||
|
||||
fltrApplicationVeto :: OpticFilterColumn t Bool
|
||||
fltrApplicationVeto queryVeto = singletonMap "veto" . FilterColumn . mkExactFilter $ view queryVeto
|
||||
|
||||
fltrApplicationVetoUI :: DBFilterUI
|
||||
fltrApplicationVetoUI mPrev = prismAForm (singletonFilter "veto" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgCourseApplicationVeto)
|
||||
|
||||
colApplicationRatingComment :: OpticColonnade (Maybe Text)
|
||||
colApplicationRatingComment resultComment = Colonnade.singleton (fromSortable header) body
|
||||
where
|
||||
header = Sortable (Just "comment") (i18nCell MsgApplicationRatingComment)
|
||||
body = views resultComment . maybe mempty $ cell . modal (toWidget $ hasComment True) . Right . toWidget
|
||||
|
||||
sortApplicationRatingComment :: OpticSortColumn (Maybe Text)
|
||||
sortApplicationRatingComment queryComment = singletonMap "comment" . SortColumn $ view queryComment
|
||||
|
||||
fltrApplicationRatingComment :: OpticFilterColumn' t (Set Text) (E.SqlExpr (E.Value (Maybe Text)))
|
||||
fltrApplicationRatingComment queryComment = singletonMap "comment" . FilterColumn . mkContainsFilterWith Just $ view queryComment
|
||||
|
||||
fltrApplicationRatingCommentUI :: DBFilterUI
|
||||
fltrApplicationRatingCommentUI mPrev = prismAForm (singletonFilter "comment") mPrev $ aopt textField (fslI MsgApplicationRatingComment)
|
||||
|
||||
colApplicationText :: OpticColonnade (Maybe Text)
|
||||
colApplicationText resultText = Colonnade.singleton (fromSortable header) body
|
||||
where
|
||||
header = Sortable (Just "text") (i18nCell MsgCourseApplicationText)
|
||||
body = views resultText . maybe mempty $ cell . modal (toWidget $ hasComment True) . Right . toWidget
|
||||
|
||||
sortApplicationText :: OpticSortColumn (Maybe Text)
|
||||
sortApplicationText queryText = singletonMap "text" . SortColumn $ view queryText
|
||||
|
||||
fltrApplicationText :: OpticFilterColumn' t (Set Text) (E.SqlExpr (E.Value (Maybe Text)))
|
||||
fltrApplicationText queryText = singletonMap "text" . FilterColumn . mkContainsFilterWith Just $ view queryText
|
||||
|
||||
fltrApplicationTextUI :: DBFilterUI
|
||||
fltrApplicationTextUI mPrev = prismAForm (singletonFilter "text") mPrev $ aopt textField (fslI MsgCourseApplicationText)
|
||||
|
||||
|
||||
colApplicationFiles :: OpticColonnade (TermId, SchoolId, CourseShorthand, CourseApplicationId, Bool) -- ^ `Bool` controls whether link is shown, use result of determination whether files exist
|
||||
colApplicationFiles resultInfo = Colonnade.singleton (fromSortable header) body
|
||||
where
|
||||
header = Sortable (Just "has-files") (i18nCell MsgCourseApplicationFiles)
|
||||
body = views resultInfo $ \(tid, ssh, csh, appId, showLink) -> if
|
||||
| showLink
|
||||
-> flip anchorCellM (asWidgetT $ toWidget iconApplicationFiles) $ do
|
||||
cID <- encrypt appId
|
||||
return $ CApplicationR tid ssh csh cID CAFilesR
|
||||
| otherwise
|
||||
-> mempty
|
||||
|
||||
sortApplicationFiles :: OpticSortColumn Bool
|
||||
sortApplicationFiles queryFiles = singletonMap "has-files" . SortColumn $ view queryFiles
|
||||
|
||||
fltrApplicationFiles :: OpticFilterColumn t Bool
|
||||
fltrApplicationFiles queryFiles = singletonMap "has-files" . FilterColumn . mkExactFilter $ view queryFiles
|
||||
|
||||
fltrApplicationFilesUI :: DBFilterUI
|
||||
fltrApplicationFilesUI mPrev = prismAForm (singletonFilter "has-files" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgCourseApplicationFiles)
|
||||
|
||||
---------------
|
||||
-- Files
|
||||
---------------
|
||||
|
||||
-- | Generic column for links to FilePaths, where the link depends on the entire table row
|
||||
colFilePath :: (IsDBTable m c) => (t -> E.Value FilePath) -> (t -> Route UniWorX) -> Colonnade Sortable t (DBCell m c)
|
||||
@ -447,6 +284,7 @@ defaultSortingByFileModification = defaultSorting [SortAscBy "time"]
|
||||
|
||||
---------------
|
||||
-- User names
|
||||
---------------
|
||||
|
||||
colUserDisplayName :: OpticColonnade (UserDisplayName, UserSurname)
|
||||
colUserDisplayName resultDisplayName = Colonnade.singleton (fromSortable header) body
|
||||
@ -866,57 +704,6 @@ fltrRelevantStudyFeaturesSemester queryTermUser = singletonMap "features-semeste
|
||||
fltrRelevantStudyFeaturesSemesterUI :: DBFilterUI
|
||||
fltrRelevantStudyFeaturesSemesterUI = fltrFeaturesSemesterUI
|
||||
|
||||
-----------------
|
||||
-- Allocations --
|
||||
-----------------
|
||||
|
||||
colAllocationApplied :: OpticColonnade Int
|
||||
colAllocationApplied resultApplied = Colonnade.singleton (fromSortable header) body
|
||||
where
|
||||
header = Sortable (Just "applied") (i18nCell MsgAllocationUsersApplied)
|
||||
body = views resultApplied $ cell . toWidget . toMarkup
|
||||
|
||||
sortAllocationApplied :: forall applied. PersistField applied => OpticSortColumn applied
|
||||
sortAllocationApplied queryApplied = singletonMap "applied" . SortColumn $ view queryApplied
|
||||
|
||||
colAllocationAssigned :: OpticColonnade Int
|
||||
colAllocationAssigned resultAssigned = Colonnade.singleton (fromSortable header) body
|
||||
where
|
||||
header = Sortable (Just "assigned") (i18nCell MsgAllocationUsersAssigned)
|
||||
body = views resultAssigned $ cell . toWidget . toMarkup
|
||||
|
||||
sortAllocationAssigned :: forall assigned. PersistField assigned => OpticSortColumn assigned
|
||||
sortAllocationAssigned queryAssigned = singletonMap "assigned" . SortColumn $ view queryAssigned
|
||||
|
||||
colAllocationVetoed :: OpticColonnade Int
|
||||
colAllocationVetoed resultVetoed = Colonnade.singleton (fromSortable header) body
|
||||
where
|
||||
header = Sortable (Just "vetoed") (i18nCell MsgAllocationUsersVetoed)
|
||||
body = views resultVetoed $ cell . toWidget . toMarkup
|
||||
|
||||
sortAllocationVetoed :: forall vetoed. PersistField vetoed => OpticSortColumn vetoed
|
||||
sortAllocationVetoed queryVetoed = singletonMap "vetoed" . SortColumn $ view queryVetoed
|
||||
|
||||
colAllocationRequested :: OpticColonnade Natural
|
||||
colAllocationRequested resultRequested = Colonnade.singleton (fromSortable header) body
|
||||
where
|
||||
header = Sortable (Just "requested") (i18nCell MsgAllocationUsersRequested)
|
||||
body = views resultRequested $ cell . toWidget . toMarkup
|
||||
|
||||
sortAllocationRequested :: forall requested. PersistField requested => OpticSortColumn requested
|
||||
sortAllocationRequested queryRequested = singletonMap "requested" . SortColumn $ view queryRequested
|
||||
|
||||
colAllocationPriority :: OpticColonnade AllocationPriority
|
||||
colAllocationPriority resultPriority = Colonnade.singleton (fromSortable header) body
|
||||
where
|
||||
header = Sortable (Just "priority") (i18nCell MsgAllocationUsersPriority)
|
||||
body = views resultPriority $ \priority -> cell $(widgetFile "table/cell/allocation-priority")
|
||||
|
||||
sortAllocationPriority :: OpticSortColumn (Maybe AllocationPriority)
|
||||
sortAllocationPriority queryPriority = singletonMap "priority" . SortColumns . views queryPriority . (. IE.veryUnsafeCoerceSqlExprValue) $ \prio ->
|
||||
[ SomeExprValue (prio E.->. "priorities" :: E.JSONBExpr Void)
|
||||
, SomeExprValue (prio E.->. "ordinal" :: E.JSONBExpr Void)
|
||||
]
|
||||
|
||||
----------------------------
|
||||
-- Colonnade manipulation --
|
||||
|
||||
@ -588,7 +588,6 @@ data DBSTemplateMode r = DBSTDefault { dbstmNumber :: Int64 -> Bool, dbstmShowNu
|
||||
(Traversal' r (Entity User)) -- lecturers
|
||||
(Lens' r Bool) -- isRegistered
|
||||
(Lens' r (Entity School)) -- school
|
||||
(Traversal' r (Entity Allocation)) -- allocation
|
||||
(Lens' r Bool) -- mayEditCourse
|
||||
|
||||
instance Default (DBStyle r) where
|
||||
@ -1512,7 +1511,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
wHeaders <- maybe (return Nothing) (fmap Just . genHeaders (dbtColonnade ^. _Cornice)) pSortable
|
||||
now <- liftIO getCurrentTime
|
||||
case dbsTemplate of
|
||||
DBSTCourse c l r s a e -> do
|
||||
DBSTCourse c l r s e -> do
|
||||
wRows <- forM rows $ \row' -> let
|
||||
Course{..} = row' ^. c . _entityVal
|
||||
lecturerUsers = row' ^.. l
|
||||
@ -1523,7 +1522,6 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
courseIsVisible = NTop courseVisibleFrom <= nmnow && nmnow <= NTop courseVisibleTo
|
||||
courseSchoolName = schoolName $ row' ^. s . _entityVal
|
||||
courseSemester = (termToText . unTermKey) courseTerm
|
||||
courseAllocation = row' ^? a
|
||||
in return $(widgetFile "table/course/course-teaser")
|
||||
return $(widgetFile "table/course/colonnade")
|
||||
DBSTDefault{..} -> do
|
||||
|
||||
@ -262,10 +262,7 @@ data UserAssimilateException = UserAssimilateException
|
||||
|
||||
data UserAssimilateExceptionReason
|
||||
= UserAssimilateExternalExamResultDifferentResult (Entity ExternalExamResult) (Entity ExternalExamResult)
|
||||
| UserAssimilateCourseParticipantDifferentAllocation (Entity CourseParticipant) (Entity CourseParticipant)
|
||||
| UserAssimilateSubmissionGroupUserMultiple (Entity SubmissionGroupUser) (Entity SubmissionGroupUser)
|
||||
| UserAssimilateAllocationUserDifferentPriority (Entity AllocationUser) (Entity AllocationUser)
|
||||
| UserAssimilateAllocationDeregisterDuplicateCourse (Entity AllocationDeregister) (Entity AllocationDeregister)
|
||||
| UserAssimilateExamRegistrationDifferentOccurrence (Entity ExamRegistration) (Entity ExamRegistration)
|
||||
| UserAssimilateExamPartResultDifferentResult (Entity ExamPartResult) (Entity ExamPartResult)
|
||||
| UserAssimilateExamBonusDifferentBonus (Entity ExamBonus) (Entity ExamBonus)
|
||||
@ -307,19 +304,6 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
|
||||
(\_current _excluded -> [])
|
||||
deleteWhere [ CourseNoFavouriteUser ==. oldUserId ]
|
||||
|
||||
let getCourseApplications = selectSource [ CourseApplicationUser ==. oldUserId ] []
|
||||
upsertCourseApplication (Entity oldAppId oldApp) = do
|
||||
newApp <- selectList [CourseApplicationUser ==. newUserId, CourseApplicationCourse ==. courseApplicationCourse oldApp, CourseApplicationAllocation ==. courseApplicationAllocation oldApp] [LimitTo 1]
|
||||
case newApp of
|
||||
(_ : _) -> return ()
|
||||
[] -> do
|
||||
newAppId <- insert oldApp
|
||||
{ courseApplicationUser = newUserId
|
||||
}
|
||||
updateWhere [ CourseApplicationFileApplication ==. oldAppId ] [ CourseApplicationFileApplication =. newAppId ]
|
||||
delete oldAppId
|
||||
in runConduit $ getCourseApplications .| C.mapM_ upsertCourseApplication
|
||||
|
||||
E.insertSelectWithConflict
|
||||
UniqueExamOfficeField
|
||||
(E.from $ \examOfficeField -> do
|
||||
@ -455,16 +439,6 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
|
||||
(\_current excluded -> [ LecturerType E.=. excluded E.^. LecturerType ])
|
||||
deleteWhere [ LecturerUser ==. oldUserId ]
|
||||
|
||||
do
|
||||
collision <- E.selectMaybe . E.from $ \(courseParticipantA `E.InnerJoin` courseParticipantB) -> do
|
||||
E.on $ courseParticipantA E.^. CourseParticipantCourse E.==. courseParticipantB E.^. CourseParticipantCourse
|
||||
E.&&. courseParticipantA E.^. CourseParticipantUser E.==. E.val oldUserId
|
||||
E.&&. courseParticipantB E.^. CourseParticipantUser E.==. E.val newUserId
|
||||
E.where_ . E.isJust $ courseParticipantA E.^. CourseParticipantAllocated
|
||||
E.where_ . E.isJust $ courseParticipantB E.^. CourseParticipantAllocated
|
||||
return (courseParticipantA, courseParticipantB)
|
||||
whenIsJust collision $ \(oldParticipant, newParticipant)
|
||||
-> tellError $ UserAssimilateCourseParticipantDifferentAllocation oldParticipant newParticipant
|
||||
E.insertSelectWithConflict
|
||||
UniqueParticipant
|
||||
(E.from $ \courseParticipant -> do
|
||||
@ -473,13 +447,11 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
|
||||
E.<# (courseParticipant E.^. CourseParticipantCourse)
|
||||
E.<&> E.val newUserId
|
||||
E.<&> (courseParticipant E.^. CourseParticipantRegistration)
|
||||
E.<&> (courseParticipant E.^. CourseParticipantAllocated)
|
||||
E.<&> (courseParticipant E.^. CourseParticipantState)
|
||||
)
|
||||
(\current excluded ->
|
||||
[ CourseParticipantState E.=. E.exprLift min (current E.^. CourseParticipantState) (excluded E.^. CourseParticipantState)
|
||||
, CourseParticipantRegistration E.=. E.max (current E.^. CourseParticipantRegistration) (excluded E.^. CourseParticipantRegistration)
|
||||
, CourseParticipantAllocated E.=. E.alt (current E.^. CourseParticipantAllocated) (excluded E.^. CourseParticipantAllocated)
|
||||
]
|
||||
)
|
||||
deleteWhere [ CourseParticipantUser ==. oldUserId ]
|
||||
@ -570,50 +542,6 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
|
||||
(\_current _excluded -> [])
|
||||
deleteWhere [ UserGroupMemberUser ==. oldUserId ]
|
||||
|
||||
do
|
||||
collisions <- E.select . E.from $ \(allocationUserA `E.InnerJoin` allocationUserB) -> do
|
||||
E.on $ allocationUserA E.^. AllocationUserAllocation E.==. allocationUserB E.^. AllocationUserAllocation
|
||||
E.&&. allocationUserA E.^. AllocationUserUser E.==. E.val oldUserId
|
||||
E.&&. allocationUserB E.^. AllocationUserUser E.==. E.val newUserId
|
||||
E.where_ $ allocationUserA E.^. AllocationUserPriority E.!=. allocationUserB E.^. AllocationUserPriority
|
||||
return (allocationUserA, allocationUserB)
|
||||
forM_ collisions $ \(oldAllocUser, newAllocUser)
|
||||
-> tellWarning $ UserAssimilateAllocationUserDifferentPriority oldAllocUser newAllocUser
|
||||
E.insertSelectWithConflict
|
||||
UniqueAllocationUser
|
||||
(E.from $ \allocationUser -> do
|
||||
E.where_ $ allocationUser E.^. AllocationUserUser E.==. E.val oldUserId
|
||||
return $ AllocationUser
|
||||
E.<# (allocationUser E.^. AllocationUserAllocation)
|
||||
E.<&> E.val newUserId
|
||||
E.<&> (allocationUser E.^. AllocationUserTotalCourses)
|
||||
E.<&> (allocationUser E.^. AllocationUserPriority)
|
||||
)
|
||||
(\current excluded -> [ AllocationUserTotalCourses E.=. E.max (current E.^. AllocationUserTotalCourses) (excluded E.^. AllocationUserTotalCourses) ])
|
||||
deleteWhere [ AllocationUserUser ==. oldUserId ]
|
||||
|
||||
do
|
||||
collisions <- E.select . E.from $ \(allocationDeregisterA `E.InnerJoin` allocationDeregisterB) -> do
|
||||
E.on $ allocationDeregisterA E.^. AllocationDeregisterCourse E.==. allocationDeregisterB E.^. AllocationDeregisterCourse
|
||||
E.&&. allocationDeregisterA E.^. AllocationDeregisterUser E.==. E.val oldUserId
|
||||
E.&&. allocationDeregisterB E.^. AllocationDeregisterUser E.==. E.val newUserId
|
||||
return (allocationDeregisterA, allocationDeregisterB)
|
||||
forM_ collisions $ \(oldAllocationDeregister, newAllocationDeregister) ->
|
||||
tellWarning $ UserAssimilateAllocationDeregisterDuplicateCourse oldAllocationDeregister newAllocationDeregister
|
||||
updateWhere [ AllocationDeregisterUser ==. oldUserId ] [ AllocationDeregisterUser =. newUserId ]
|
||||
|
||||
E.insertSelectWithConflict
|
||||
UniqueAllocationNotificationSetting
|
||||
(E.from $ \allocNotifySetting -> do
|
||||
E.where_ $ allocNotifySetting E.^. AllocationNotificationSettingUser E.==. E.val oldUserId
|
||||
return $ AllocationNotificationSetting
|
||||
E.<# E.val newUserId
|
||||
E.<&> (allocNotifySetting E.^. AllocationNotificationSettingAllocation)
|
||||
E.<&> (allocNotifySetting E.^. AllocationNotificationSettingIsOptOut)
|
||||
)
|
||||
(\current excluded -> [ AllocationNotificationSettingIsOptOut E.=. (current E.^. AllocationNotificationSettingIsOptOut E.||. excluded E.^. AllocationNotificationSettingIsOptOut) ])
|
||||
deleteWhere [ AllocationNotificationSettingUser ==. oldUserId ]
|
||||
|
||||
do
|
||||
collisions <- E.select . E.from $ \(examRegistrationA `E.InnerJoin` examRegistrationB) -> do
|
||||
E.on $ examRegistrationA E.^. ExamRegistrationExam E.==. examRegistrationB E.^. ExamRegistrationExam
|
||||
|
||||
@ -553,69 +553,6 @@ determineCrontab = execWriterT $ do
|
||||
|
||||
runConduit $ transPipe lift (selectKeys [] []) .| C.mapM_ externalExamJobs
|
||||
|
||||
|
||||
allocations <- lift $ selectList [] []
|
||||
|
||||
let
|
||||
allocationTimes :: EntityField Allocation (Maybe UTCTime) -> MergeHashMap UTCTime [Entity Allocation]
|
||||
allocationTimes aField = flip foldMap allocations $ \allocEnt -> case allocEnt ^. fieldLens aField of
|
||||
Nothing -> mempty
|
||||
Just t -> _MergeHashMap # HashMap.singleton t (pure allocEnt)
|
||||
|
||||
forM_ allocations $ \(Entity nAllocation _) -> do
|
||||
doneSince <- lift $ fmap (E.unValue <=< listToMaybe) . E.select . E.from $ \participant -> do
|
||||
E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
|
||||
return . E.max_ $ participant E.^. CourseParticipantRegistration
|
||||
|
||||
whenIsJust doneSince $ \doneSince' ->
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobQueueNotification NotificationAllocationResults{..})
|
||||
Cron
|
||||
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay doneSince'
|
||||
, cronRepeat = CronRepeatOnChange
|
||||
, cronRateLimit = appNotificationRateLimit
|
||||
, cronNotAfter = Right . CronTimestamp . utcToLocalTimeTZ appTZ . addUTCTime appNotificationCollateDelay $ addUTCTime appNotificationExpiration doneSince'
|
||||
}
|
||||
|
||||
iforM_ (allocationTimes AllocationStaffRegisterFrom) $ \staffRegisterFrom allocs ->
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobQueueNotification NotificationAllocationStaffRegister{ nAllocations = setOf (folded . _entityKey) allocs })
|
||||
Cron
|
||||
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ staffRegisterFrom
|
||||
, cronRepeat = CronRepeatOnChange
|
||||
, cronRateLimit = appNotificationRateLimit
|
||||
, cronNotAfter = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) $ nBot =<< minimumOf (folded . _entityVal . _allocationStaffRegisterTo . to NTop . filtered (> NTop (Just staffRegisterFrom))) allocs
|
||||
}
|
||||
iforM_ (allocationTimes AllocationRegisterFrom) $ \registerFrom allocs ->
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobQueueNotification NotificationAllocationRegister{ nAllocations = setOf (folded . _entityKey) allocs })
|
||||
Cron
|
||||
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ registerFrom
|
||||
, cronRepeat = CronRepeatOnChange
|
||||
, cronRateLimit = appNotificationRateLimit
|
||||
, cronNotAfter = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) $ nBot =<< minimumOf (folded . _entityVal . _allocationRegisterTo . to NTop . filtered (> NTop (Just registerFrom))) allocs
|
||||
}
|
||||
-- iforM_ (allocationTimes AllocationStaffAllocationFrom) $ \staffAllocationFrom allocs ->
|
||||
-- tell $ HashMap.singleton
|
||||
-- (JobCtlQueue $ JobQueueNotification NotificationAllocationAllocation{ nAllocations = setOf (folded . _entityKey) allocs })
|
||||
-- Cron
|
||||
-- { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ staffAllocationFrom
|
||||
-- , cronRepeat = CronRepeatOnChange
|
||||
-- , cronRateLimit = appNotificationRateLimit
|
||||
-- , cronNotAfter = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) $ nBot =<< minimumOf (folded . _entityVal . _allocationStaffAllocationTo . to NTop . filtered (> NTop (Just staffAllocationFrom))) allocs
|
||||
-- }
|
||||
iforM_ (allocationTimes AllocationRegisterTo) $ \registerTo allocs' -> do
|
||||
let allocs = flip filter allocs' $ \(Entity _ Allocation{..}) -> maybe True (> registerTo) allocationStaffAllocationTo
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobQueueNotification NotificationAllocationUnratedApplications{ nAllocations = setOf (folded . _entityKey) allocs })
|
||||
Cron
|
||||
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ registerTo
|
||||
, cronRepeat = CronRepeatOnChange
|
||||
, cronRateLimit = appNotificationRateLimit
|
||||
, cronNotAfter = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) $ nBot =<< minimumOf (folded . _entityVal . _allocationStaffAllocationTo . to NTop . filtered (> NTop (Just registerTo))) allocs
|
||||
}
|
||||
|
||||
|
||||
hasRelevanceUncached <- lift $ exists [StudyFeaturesRelevanceCached ==. Nothing]
|
||||
when hasRelevanceUncached . tell $ HashMap.singleton
|
||||
(JobCtlQueue JobStudyFeaturesCacheRelevance)
|
||||
|
||||
@ -70,13 +70,11 @@ dispatchJobPruneSessionFiles = JobHandlerAtomicWithFinalizer act fin
|
||||
|
||||
fileReferences :: E.SqlExpr (E.Value FileContentReference) -> [E.SqlQuery ()]
|
||||
fileReferences fHash'@(E.just -> fHash)
|
||||
= [ E.from $ \appFile -> E.where_ $ appFile E.^. CourseApplicationFileContent E.==. fHash
|
||||
, E.from $ \matFile -> E.where_ $ matFile E.^. MaterialFileContent E.==. fHash
|
||||
= [ E.from $ \matFile -> E.where_ $ matFile E.^. MaterialFileContent E.==. fHash
|
||||
, E.from $ \newsFile -> E.where_ $ newsFile E.^. CourseNewsFileContent E.==. fHash
|
||||
, E.from $ \sheetFile -> E.where_ $ sheetFile E.^. SheetFileContent E.==. fHash
|
||||
, E.from $ \sheetFile -> E.where_ $ sheetFile E.^. PersonalisedSheetFileContent E.==. fHash
|
||||
, E.from $ \appInstr -> E.where_ $ appInstr E.^. CourseAppInstructionFileContent E.==. fHash
|
||||
, E.from $ \matching -> E.where_ $ E.just (matching E.^. AllocationMatchingLog) E.==. fHash
|
||||
, E.from $ \subFile -> E.where_ $ subFile E.^. SubmissionFileContent E.==. fHash
|
||||
, E.from $ \sessFile -> E.where_ $ sessFile E.^. SessionFileContent E.==. fHash
|
||||
, E.from $ \lock -> E.where_ $ E.just (lock E.^. FileLockContent) E.==. fHash
|
||||
@ -146,15 +144,13 @@ dispatchJobDetectMissingFiles = JobHandlerAtomicDeferrableWithFinalizer act fin
|
||||
$logInfoS "MissingFiles" [st|No missing files|]
|
||||
|
||||
trackedReferences = Map.fromList $ over (traverse . _1) nameToPathPiece
|
||||
[ (''CourseApplicationFile, E.from $ \appFile -> return $ appFile E.^. CourseApplicationFileContent )
|
||||
, (''MaterialFile, E.from $ \matFile -> return $ matFile E.^. MaterialFileContent )
|
||||
[ (''MaterialFile, E.from $ \matFile -> return $ matFile E.^. MaterialFileContent )
|
||||
, (''CourseNewsFile, E.from $ \newsFile -> return $ newsFile E.^. CourseNewsFileContent )
|
||||
, (''SheetFile, E.from $ \sheetFile -> return $ sheetFile E.^. SheetFileContent )
|
||||
, (''PersonalisedSheetFile, E.from $ \personalisedSheetFile -> return $ personalisedSheetFile E.^. PersonalisedSheetFileContent )
|
||||
, (''CourseAppInstructionFile, E.from $ \appInstr -> return $ appInstr E.^. CourseAppInstructionFileContent)
|
||||
, (''SubmissionFile, E.from $ \subFile -> return $ subFile E.^. SubmissionFileContent )
|
||||
, (''SessionFile, E.from $ \sessFile -> return $ sessFile E.^. SessionFileContent )
|
||||
, (''AllocationMatching, E.from $ \matching -> return . E.just $ matching E.^. AllocationMatchingLog)
|
||||
]
|
||||
|
||||
|
||||
|
||||
@ -11,14 +11,12 @@ import Import
|
||||
import Jobs.Types
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
import Jobs.Queue
|
||||
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import Handler.Utils.ExamOffice.Exam
|
||||
import Handler.Utils.ExamOffice.ExternalExam
|
||||
import Handler.Utils.Allocation (allocationNotifyNewCourses)
|
||||
|
||||
import qualified Data.Conduit.Combinators as C
|
||||
|
||||
@ -37,28 +35,6 @@ determineNotificationCandidates = awaitForever $ \notif -> do
|
||||
let withNotif :: ConduitT () (Entity User) DB () -> ConduitT Notification (Notification, Bool, Entity User) DB ()
|
||||
withNotif c = toProducer c .| C.map (notif, False, )
|
||||
|
||||
withNotifOverride :: ConduitT () (E.Value Bool, Entity User) DB () -> ConduitT Notification (Notification, Bool, Entity User) DB ()
|
||||
withNotifOverride c = toProducer c .| C.map (\(E.Value override, user) -> (notif, override, user))
|
||||
|
||||
-- | Assumes that conduit produces output sorted by `UserId`
|
||||
separateTargets :: Ord target
|
||||
=> (Set target -> Notification)
|
||||
-> ConduitT () (Entity User, E.Value target) DB ()
|
||||
-> ConduitT Notification (Notification, Bool, Entity User) DB ()
|
||||
separateTargets mkNotif' c = toProducer c .| go Nothing Set.empty
|
||||
where go Nothing _ = do
|
||||
next <- await
|
||||
case next of
|
||||
Nothing -> return ()
|
||||
Just (uent, E.Value t) -> go (Just uent) $ Set.singleton t
|
||||
go (Just uent) ts = do
|
||||
next <- await
|
||||
case next of
|
||||
Nothing -> yield (mkNotif' ts, False, uent)
|
||||
Just next'@(uent', E.Value t)
|
||||
| ((==) `on` entityKey) uent uent' -> go (Just uent) $ Set.insert t ts
|
||||
| otherwise -> yield (mkNotif' ts, False, uent) >> leftover next' >> go Nothing Set.empty
|
||||
|
||||
case notif of
|
||||
NotificationSubmissionRated{..}
|
||||
-> withNotif . E.selectSource . E.from $ \(user `E.InnerJoin` submissionUser) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
||||
@ -159,78 +135,6 @@ determineNotificationCandidates = awaitForever $ \notif -> do
|
||||
whenIsJust lastExec $ \lastExec' ->
|
||||
E.where_ $ examResult E.^. ExamResultLastChanged E.>. E.val lastExec'
|
||||
return user
|
||||
NotificationAllocationStaffRegister{..}
|
||||
-> separateTargets NotificationAllocationStaffRegister . E.selectSource . E.from $ \(user `E.InnerJoin` userFunction `E.InnerJoin` allocation) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId, E.asc $ allocation E.^. AllocationId] $ do
|
||||
E.on $ userFunction E.^. UserFunctionSchool E.==. allocation E.^. AllocationSchool
|
||||
E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
|
||||
|
||||
E.where_ $ userFunction E.^. UserFunctionFunction E.==. E.val SchoolLecturer
|
||||
E.&&. allocation E.^. AllocationId `E.in_` E.valList (Set.toList nAllocations)
|
||||
|
||||
E.where_ . E.exists . E.from $ \userSchool ->
|
||||
E.where_ $ userSchool E.^. UserSchoolUser E.==. user E.^. UserId
|
||||
E.&&. userSchool E.^. UserSchoolSchool E.==. allocation E.^. AllocationSchool
|
||||
E.&&. E.not_ (userSchool E.^. UserSchoolIsOptOut)
|
||||
|
||||
E.where_ . E.not_ . E.exists . E.from $ \(course `E.InnerJoin` lecturer) -> do
|
||||
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
|
||||
E.&&. lecturer E.^. LecturerUser E.==. user E.^. UserId
|
||||
E.where_ . E.exists . E.from $ \allocationCourse ->
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. allocation E.^. AllocationId
|
||||
|
||||
return (user, allocation E.^. AllocationId)
|
||||
NotificationAllocationRegister{..}
|
||||
-> separateTargets NotificationAllocationRegister . E.selectSource . E.from $ \(user `E.InnerJoin` allocation) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId, E.asc $ allocation E.^. AllocationId] $ do
|
||||
E.on E.true
|
||||
|
||||
E.where_ $ allocation E.^. AllocationId `E.in_` E.valList (Set.toList nAllocations)
|
||||
|
||||
E.where_ . E.exists . E.from $ \userSchool ->
|
||||
E.where_ $ userSchool E.^. UserSchoolUser E.==. user E.^. UserId
|
||||
E.&&. userSchool E.^. UserSchoolSchool E.==. allocation E.^. AllocationSchool
|
||||
E.&&. E.not_ (userSchool E.^. UserSchoolIsOptOut)
|
||||
|
||||
E.where_ . E.not_ . E.exists . E.from $ \application ->
|
||||
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (allocation E.^. AllocationId)
|
||||
E.&&. application E.^. CourseApplicationUser E.==. user E.^. UserId
|
||||
|
||||
return (user, allocation E.^. AllocationId)
|
||||
NotificationAllocationAllocation{..}
|
||||
-> separateTargets NotificationAllocationAllocation . E.selectSource . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId, E.asc $ allocationCourse E.^. AllocationCourseAllocation] $ do
|
||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
|
||||
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
|
||||
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseAllocation `E.in_` E.valList (Set.toList nAllocations)
|
||||
|
||||
E.where_ . E.not_ . E.exists . E.from $ \application ->
|
||||
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
|
||||
E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId
|
||||
E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId
|
||||
E.&&. E.not_ (E.isNothing $ application E.^. CourseApplicationRatingTime)
|
||||
|
||||
E.where_ . E.exists . E.from $ \application ->
|
||||
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
|
||||
E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId
|
||||
E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId
|
||||
|
||||
return (user, allocationCourse E.^. AllocationCourseAllocation)
|
||||
NotificationAllocationUnratedApplications{..}
|
||||
-> separateTargets NotificationAllocationUnratedApplications . E.selectSource . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId, E.asc $ allocationCourse E.^. AllocationCourseAllocation] $ do
|
||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
|
||||
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
|
||||
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseAllocation `E.in_` E.valList (Set.toList nAllocations)
|
||||
|
||||
E.where_ . E.exists . E.from $ \application ->
|
||||
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
|
||||
E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId
|
||||
E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId
|
||||
E.&&. E.isNothing (application E.^. CourseApplicationRatingTime)
|
||||
|
||||
return (user, allocationCourse E.^. AllocationCourseAllocation)
|
||||
NotificationExamOfficeExamResults{..}
|
||||
-> withNotif . E.selectSource . E.from $ \user -> do
|
||||
E.where_ . E.exists . E.from $ \examResult -> do
|
||||
@ -249,34 +153,6 @@ determineNotificationCandidates = awaitForever $ \notif -> do
|
||||
E.where_ $ externalExamResult E.^. ExternalExamResultExam E.==. E.val nExternalExam
|
||||
E.where_ $ examOfficeExternalExamResultAuth (user E.^. UserId) externalExamResult
|
||||
return user
|
||||
NotificationAllocationResults{..}
|
||||
-> do
|
||||
lastExec <- lift . fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif
|
||||
withNotif . E.selectSource . E.from $ \user -> do
|
||||
let isStudent = E.exists . E.from $ \application ->
|
||||
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (E.val nAllocation)
|
||||
E.&&. application E.^. CourseApplicationUser E.==. user E.^. UserId
|
||||
isLecturer = E.exists . E.from $ \(lecturer `E.InnerJoin` allocationCourse) ->
|
||||
E.on $ lecturer E.^. LecturerCourse E.==. allocationCourse E.^. AllocationCourseCourse
|
||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
|
||||
E.&&. lecturer E.^. LecturerUser E.==. user E.^. UserId
|
||||
|
||||
wasAllocated t = E.exists . E.from $ \participant ->
|
||||
E.where_ $ participant E.^. CourseParticipantUser E.==. user E.^. UserId
|
||||
E.&&. participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
|
||||
E.&&. participant E.^. CourseParticipantRegistration E.>. E.val t
|
||||
E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
hasAllocations t = E.exists . E.from $ \(lecturer `E.InnerJoin` participant) -> do
|
||||
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
|
||||
E.&&. lecturer E.^. LecturerCourse E.==. participant E.^. CourseParticipantCourse
|
||||
E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
|
||||
E.&&. participant E.^. CourseParticipantRegistration E.>. E.val t
|
||||
E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
case lastExec of
|
||||
Nothing -> E.where_ $ isStudent E.||. isLecturer
|
||||
Just t -> E.where_ $ wasAllocated t E.||. hasAllocations t
|
||||
|
||||
return user
|
||||
NotificationCourseRegistered{..}
|
||||
-> withNotif . yieldMMany $ getEntity nUser
|
||||
NotificationSubmissionEdited{..}
|
||||
@ -289,21 +165,6 @@ determineNotificationCandidates = awaitForever $ \notif -> do
|
||||
-> withNotif . yieldMMany $ getEntity nUser
|
||||
NotificationSubmissionUserDeleted{..}
|
||||
-> withNotif . yieldMMany $ getEntity nUser
|
||||
NotificationAllocationNewCourse{..}
|
||||
-> withNotifOverride . E.selectSource . E.from $ \user -> do
|
||||
let hasOverride = E.exists . E.from $ \allocationNotificationSetting ->
|
||||
E.where_ $ allocationNotificationSetting E.^. AllocationNotificationSettingUser E.==. user E.^. UserId
|
||||
E.&&. allocationNotificationSetting E.^. AllocationNotificationSettingAllocation E.==. E.val nAllocation
|
||||
E.&&. E.not_ (allocationNotificationSetting E.^. AllocationNotificationSettingIsOptOut)
|
||||
|
||||
E.where_ . allocationNotifyNewCourses (E.val nAllocation) $ user E.^. UserId
|
||||
|
||||
E.where_ . E.not_ . E.exists . E.from $ \application ->
|
||||
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.justVal nAllocation
|
||||
E.&&. application E.^. CourseApplicationUser E.==. user E.^. UserId
|
||||
E.&&. application E.^. CourseApplicationCourse E.==. E.val nCourse
|
||||
|
||||
return (hasOverride, user)
|
||||
NotificationQualificationExpiry{} -> return mempty -- Not to be used with JobQueueNotification; recipients already known
|
||||
NotificationQualificationExpired{} -> return mempty -- Not to be used with JobQueueNotification; recipients already known
|
||||
NotificationQualificationRenewal{} -> return mempty -- Not to be used with JobQueueNotification; recipients already known
|
||||
@ -330,19 +191,13 @@ classifyNotification NotificationExamRegistrationActive{} = return NTExa
|
||||
classifyNotification NotificationExamRegistrationSoonInactive{} = return NTExamRegistrationSoonInactive
|
||||
classifyNotification NotificationExamDeregistrationSoonInactive{} = return NTExamDeregistrationSoonInactive
|
||||
classifyNotification NotificationExamResult{} = return NTExamResult
|
||||
classifyNotification NotificationAllocationStaffRegister{} = return NTAllocationStaffRegister
|
||||
classifyNotification NotificationAllocationAllocation{} = return NTAllocationAllocation
|
||||
classifyNotification NotificationAllocationRegister{} = return NTAllocationRegister
|
||||
classifyNotification NotificationAllocationUnratedApplications{} = return NTAllocationUnratedApplications
|
||||
classifyNotification NotificationExamOfficeExamResults{} = return NTExamOfficeExamResults
|
||||
classifyNotification NotificationExamOfficeExamResultsChanged{} = return NTExamOfficeExamResultsChanged
|
||||
classifyNotification NotificationExamOfficeExternalExamResults{} = return NTExamOfficeExamResults
|
||||
classifyNotification NotificationAllocationResults{} = return NTAllocationResults
|
||||
classifyNotification NotificationCourseRegistered{} = return NTCourseRegistered
|
||||
classifyNotification NotificationSubmissionEdited{} = return NTSubmissionEdited
|
||||
classifyNotification NotificationSubmissionUserCreated{} = return NTSubmissionUserCreated
|
||||
classifyNotification NotificationSubmissionUserDeleted{} = return NTSubmissionUserDeleted
|
||||
classifyNotification NotificationAllocationNewCourse{} = return NTAllocationNewCourse
|
||||
classifyNotification NotificationQualificationExpiry{} = return NTQualification
|
||||
classifyNotification NotificationQualificationExpired{} = return NTQualification
|
||||
classifyNotification NotificationQualificationRenewal{} = return NTQualification
|
||||
|
||||
@ -20,7 +20,6 @@ import Jobs.Handler.SendNotification.UserRightsUpdate
|
||||
import Jobs.Handler.SendNotification.UserAuthModeUpdate
|
||||
import Jobs.Handler.SendNotification.ExamActive
|
||||
import Jobs.Handler.SendNotification.ExamResult
|
||||
import Jobs.Handler.SendNotification.Allocation
|
||||
import Jobs.Handler.SendNotification.ExamOffice
|
||||
import Jobs.Handler.SendNotification.CourseRegistered
|
||||
import Jobs.Handler.SendNotification.SubmissionEdited
|
||||
|
||||
@ -1,216 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -- ihamletFile discards do results
|
||||
|
||||
module Jobs.Handler.SendNotification.Allocation
|
||||
( dispatchNotificationAllocationStaffRegister
|
||||
, dispatchNotificationAllocationRegister
|
||||
, dispatchNotificationAllocationAllocation
|
||||
, dispatchNotificationAllocationUnratedApplications
|
||||
, dispatchNotificationAllocationResults
|
||||
, dispatchNotificationAllocationNewCourse
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils
|
||||
import Jobs.Handler.SendNotification.Utils
|
||||
|
||||
import Handler.Info (FAQItem(..))
|
||||
|
||||
import Text.Hamlet
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
|
||||
dispatchNotificationAllocationStaffRegister :: Set AllocationId -> UserId -> Handler ()
|
||||
dispatchNotificationAllocationStaffRegister (otoList -> nAllocations) jRecipient = userMailT jRecipient $ do
|
||||
allocs <- fmap (sortOn $ \Allocation{..} -> (allocationSchool, allocationName)) . liftHandler . runDB $ mapM getJust nAllocations
|
||||
|
||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||
case allocs of
|
||||
[Allocation{..}] ->
|
||||
setSubjectI $ MsgMailSubjectAllocationStaffRegister allocationSchool allocationName
|
||||
_other ->
|
||||
setSubjectI . MsgMailSubjectAllocationStaffRegisterMultiple $ length allocs
|
||||
editNotifications <- mkEditNotifications jRecipient
|
||||
deadlines <- forM allocs $ \alloc@Allocation{..} -> (alloc,) <$> traverse (formatTime SelFormatDateTime) allocationStaffRegisterTo
|
||||
let doRegisterDeadlines = any (is _Just . allocationStaffRegisterTo) allocs
|
||||
singleRegisterDeadline = maybe True (flip all (allocs ^.. folded . _allocationStaffRegisterTo) . (==)) $ allocs ^? _head . _allocationStaffRegisterTo
|
||||
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationStaffRegister.hamlet")
|
||||
|
||||
dispatchNotificationAllocationRegister :: Set AllocationId -> UserId -> Handler ()
|
||||
dispatchNotificationAllocationRegister (otoList -> nAllocations) jRecipient = userMailT jRecipient $ do
|
||||
allocs <- fmap (sortOn $ \Allocation{..} -> (allocationSchool, allocationName)) . liftHandler . runDB $ mapM getJust nAllocations
|
||||
|
||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||
case allocs of
|
||||
[Allocation{..}] ->
|
||||
setSubjectI $ MsgMailSubjectAllocationRegister allocationSchool allocationName
|
||||
_other ->
|
||||
setSubjectI . MsgMailSubjectAllocationRegisterMultiple $ length allocs
|
||||
editNotifications <- mkEditNotifications jRecipient
|
||||
deadlines <- forM allocs $ \alloc@Allocation{..} -> (alloc,) <$> traverse (formatTime SelFormatDateTime) allocationRegisterTo
|
||||
let doRegisterDeadlines = any (is _Just . allocationRegisterTo) allocs
|
||||
singleRegisterDeadline = maybe True (flip all (allocs ^.. folded . _allocationRegisterTo) . (==)) $ allocs ^? _head . _allocationRegisterTo
|
||||
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationRegister.hamlet")
|
||||
|
||||
dispatchNotificationAllocationAllocation :: Set AllocationId -> UserId -> Handler ()
|
||||
dispatchNotificationAllocationAllocation (otoList -> nAllocations) jRecipient = do
|
||||
courses <- fmap (nubOrdOn $ views _2 entityKey) . runDB . E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` allocation `E.InnerJoin` lecturer) -> do
|
||||
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
|
||||
E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
|
||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
|
||||
E.where_ $ lecturer E.^. LecturerUser E.==. E.val jRecipient
|
||||
E.where_ $ allocation E.^. AllocationId `E.in_` E.valList nAllocations
|
||||
|
||||
E.orderBy [ E.asc $ allocation E.^. AllocationSchool
|
||||
, E.asc $ allocation E.^. AllocationName
|
||||
, E.asc $ course E.^. CourseTerm
|
||||
, E.asc $ course E.^. CourseSchool
|
||||
, E.asc $ course E.^. CourseName
|
||||
]
|
||||
|
||||
return (allocation, course)
|
||||
|
||||
let allocations = nubOrdOn entityKey $ courses ^.. folded . _1
|
||||
|
||||
unless (null courses) . userMailT jRecipient $ do
|
||||
now <- liftIO getCurrentTime
|
||||
let doRegisterDeadlines = any (((<) `on` NTop) (Just now) . allocationRegisterTo . entityVal) allocations
|
||||
|
||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||
case allocations of
|
||||
[Entity _ Allocation{..}]
|
||||
-> setSubjectI $ MsgMailSubjectAllocationAllocation allocationSchool allocationName
|
||||
_other
|
||||
-> setSubjectI . MsgMailSubjectAllocationAllocationMultiple $ length allocations
|
||||
editNotifications <- mkEditNotifications jRecipient
|
||||
|
||||
deadlines <- forM allocations $ \(Entity _ alloc@Allocation{..}) -> (alloc,,) <$> traverse (formatTime SelFormatDateTime) (guardOnM doRegisterDeadlines allocationRegisterTo) <*> traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
|
||||
let doDeadlines = doRegisterDeadlines || any (has $ _entityVal . _allocationStaffAllocationTo . _Just) allocations
|
||||
sameDeadlines = maybe True (flip all (allocations ^.. folded . _entityVal) . ((==) `on` bool ((, Nothing) . allocationStaffAllocationTo) ((,) <$> allocationStaffAllocationTo <*> allocationRegisterTo) doRegisterDeadlines)) $ allocations ^? _head . _entityVal
|
||||
|
||||
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationAllocation.hamlet")
|
||||
|
||||
dispatchNotificationAllocationUnratedApplications :: Set AllocationId -> UserId -> Handler ()
|
||||
dispatchNotificationAllocationUnratedApplications (otoList -> nAllocations) jRecipient = do
|
||||
courses <- fmap (nubOrdOn (views _2 entityKey) . over (traverse . _3) (fromIntegral . E.unValue)) . runDB . E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` allocation `E.InnerJoin` lecturer) -> do
|
||||
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
|
||||
E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
|
||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
|
||||
E.where_ $ lecturer E.^. LecturerUser E.==. E.val jRecipient
|
||||
E.where_ $ allocation E.^. AllocationId `E.in_` E.valList nAllocations
|
||||
|
||||
let
|
||||
unratedAppCount :: E.SqlExpr (E.Value Word64)
|
||||
unratedAppCount = E.subSelectCount . E.from $ \application ->
|
||||
E.where_ $ application E.^. CourseApplicationCourse E.==. course E.^. CourseId
|
||||
E.&&. application E.^. CourseApplicationAllocation E.==. E.just (allocation E.^. AllocationId)
|
||||
E.&&. E.maybe E.true (E.<. application E.^. CourseApplicationTime) (application E.^. CourseApplicationRatingTime)
|
||||
|
||||
E.where_ $ unratedAppCount E.>. E.val 0
|
||||
|
||||
E.orderBy [ E.asc $ allocation E.^. AllocationSchool
|
||||
, E.asc $ allocation E.^. AllocationName
|
||||
, E.asc $ course E.^. CourseTerm
|
||||
, E.asc $ course E.^. CourseSchool
|
||||
, E.asc $ course E.^. CourseName
|
||||
]
|
||||
|
||||
return (allocation, course, unratedAppCount)
|
||||
|
||||
let allocations = nubOrdOn entityKey $ courses ^.. folded . _1
|
||||
|
||||
unless (null courses) . userMailT jRecipient $ do
|
||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||
case allocations of
|
||||
[Entity _ Allocation{..}]
|
||||
-> setSubjectI $ MsgMailSubjectAllocationUnratedApplications allocationSchool allocationName
|
||||
_other
|
||||
-> setSubjectI . MsgMailSubjectAllocationUnratedApplicationsMultiple $ length allocations
|
||||
editNotifications <- mkEditNotifications jRecipient
|
||||
|
||||
deadlines <- forM allocations $ \(Entity _ alloc@Allocation{..}) -> (alloc,) <$> traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
|
||||
let doDeadlines = any (has $ _entityVal . _allocationStaffAllocationTo . _Just) allocations
|
||||
sameDeadlines = maybe True (flip all (allocations ^.. folded . _entityVal) . ((==) `on` allocationStaffAllocationTo)) $ allocations ^? _head . _entityVal
|
||||
|
||||
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationUnratedApplications.hamlet")
|
||||
|
||||
dispatchNotificationAllocationResults :: AllocationId -> UserId -> Handler ()
|
||||
dispatchNotificationAllocationResults nAllocation jRecipient = userMailT jRecipient $ do
|
||||
(Allocation{..}, lecturerResults, warnSubstituteCourses, participantResults) <- liftHandler . runDB $ do
|
||||
allocation <- getJust nAllocation
|
||||
|
||||
lecturerResults' <- E.select . E.from $ \(lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> do
|
||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
|
||||
E.where_ $ lecturer E.^. LecturerUser E.==. E.val jRecipient
|
||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
|
||||
let allocatedCount :: E.SqlExpr (E.Value Int64)
|
||||
allocatedCount = E.subSelectCount . E.from $ \participant ->
|
||||
E.where_ $ participant E.^. CourseParticipantCourse E.==. lecturer E.^. LecturerCourse
|
||||
E.&&. participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
|
||||
E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
let participantCount :: E.SqlExpr (E.Value Int64)
|
||||
participantCount = E.subSelectCount . E.from $ \participant ->
|
||||
E.where_ $ participant E.^. CourseParticipantCourse E.==. lecturer E.^. LecturerCourse
|
||||
E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
return (course, allocationCourse, allocatedCount, participantCount)
|
||||
let lecturerResults = flip map lecturerResults' $ \(Entity _ Course{..}, _, E.Value allocCount, E.Value partCount) -> SomeMessage $ if
|
||||
| allocCount == partCount -> MsgAllocationResultLecturerAll courseShorthand allocCount
|
||||
| allocCount == 0 -> MsgAllocationResultLecturerNone courseShorthand
|
||||
| otherwise -> MsgAllocationResultLecturer courseShorthand allocCount partCount
|
||||
warnSubstituteCourses = flip mapMaybe lecturerResults' $ \(Entity _ course, Entity _ AllocationCourse{..}, _, _) -> guardOn (isn't _Just allocationCourseAcceptSubstitutes) course
|
||||
|
||||
doParticipantResults <- E.selectExists . E.from $ \application ->
|
||||
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (E.val nAllocation)
|
||||
E.&&. application E.^. CourseApplicationUser E.==. E.val jRecipient
|
||||
participantResults' <- E.select . E.from $ \(participant `E.InnerJoin` course) -> do
|
||||
E.on $ participant E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
||||
E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
|
||||
E.&&. participant E.^. CourseParticipantUser E.==. E.val jRecipient
|
||||
E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
return course
|
||||
let participantResults = case participantResults' of
|
||||
[] | doParticipantResults -> Just []
|
||||
| otherwise -> Nothing
|
||||
cs -> Just $ map (courseShorthand . entityVal) cs
|
||||
|
||||
return (allocation, lecturerResults, warnSubstituteCourses, participantResults)
|
||||
|
||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||
setSubjectI $ MsgMailSubjectAllocationResults allocationName
|
||||
editNotifications <- mkEditNotifications jRecipient
|
||||
|
||||
studentFaqItems <- forM studentFaqItems' $ \faqItem -> (faqItem, ) <$> toTextUrl (FaqR :#: faqItem)
|
||||
|
||||
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationResults.hamlet")
|
||||
where
|
||||
studentFaqItems' = [FAQAllocationNoPlaces]
|
||||
|
||||
dispatchNotificationAllocationNewCourse :: AllocationId -> CourseId -> UserId -> Handler ()
|
||||
dispatchNotificationAllocationNewCourse nAllocation nCourse jRecipient = userMailT jRecipient $ do
|
||||
(Allocation{..}, Course{..}, hasApplied) <- liftHandler . runDB $ (,,)
|
||||
<$> getJust nAllocation
|
||||
<*> getJust nCourse
|
||||
<*> exists [CourseApplicationAllocation ==. Just nAllocation, CourseApplicationUser ==. jRecipient]
|
||||
|
||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||
setSubjectI $ MsgMailSubjectAllocationNewCourse allocationName
|
||||
editNotifications <- mkEditNotifications jRecipient
|
||||
|
||||
cID <- encrypt nCourse
|
||||
mayApply <- lift $ orM
|
||||
[ is _Authorized <$> evalAccessFor (Just jRecipient) (AllocationR allocationTerm allocationSchool allocationShorthand ARegisterR) True
|
||||
, is _Authorized <$> evalAccessFor (Just jRecipient) (AllocationR allocationTerm allocationSchool allocationShorthand $ AApplyR cID) True
|
||||
]
|
||||
|
||||
allocUrl <- toTextUrl $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR :#: cID
|
||||
|
||||
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationNewCourse.hamlet")
|
||||
@ -134,15 +134,9 @@ data Notification
|
||||
| NotificationExamRegistrationSoonInactive { nExam :: ExamId }
|
||||
| NotificationExamDeregistrationSoonInactive { nExam :: ExamId }
|
||||
| NotificationExamResult { nExam :: ExamId }
|
||||
| NotificationAllocationStaffRegister { nAllocations :: Set AllocationId }
|
||||
| NotificationAllocationRegister { nAllocations :: Set AllocationId }
|
||||
| NotificationAllocationAllocation { nAllocations :: Set AllocationId }
|
||||
| NotificationAllocationUnratedApplications { nAllocations :: Set AllocationId }
|
||||
| NotificationAllocationNewCourse { nAllocation :: AllocationId, nCourse :: CourseId }
|
||||
| NotificationExamOfficeExamResults { nExam :: ExamId }
|
||||
| NotificationExamOfficeExamResultsChanged { nExamResults :: Set ExamResultId }
|
||||
| NotificationExamOfficeExternalExamResults { nExternalExam :: ExternalExamId }
|
||||
| NotificationAllocationResults { nAllocation :: AllocationId }
|
||||
| NotificationCourseRegistered { nUser :: UserId, nCourse :: CourseId }
|
||||
| NotificationSubmissionEdited { nInitiator :: UserId, nSubmission :: SubmissionId }
|
||||
| NotificationSubmissionUserCreated { nUser :: UserId, nSubmission :: SubmissionId }
|
||||
|
||||
58
src/Model.hs
58
src/Model.hs
@ -76,64 +76,6 @@ instance ToMessage (Key Term) where
|
||||
toMessage = termToText . unTermKey
|
||||
|
||||
|
||||
instance HasFileReference CourseApplicationFile where
|
||||
newtype FileReferenceResidual CourseApplicationFile
|
||||
= CourseApplicationFileResidual { courseApplicationFileResidualApplication :: CourseApplicationId }
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
|
||||
_FileReference
|
||||
= iso (\CourseApplicationFile{..} -> ( FileReference
|
||||
{ fileReferenceTitle = courseApplicationFileTitle
|
||||
, fileReferenceContent = courseApplicationFileContent
|
||||
, fileReferenceModified = courseApplicationFileModified
|
||||
}
|
||||
, CourseApplicationFileResidual courseApplicationFileApplication
|
||||
)
|
||||
)
|
||||
(\( FileReference{..}
|
||||
, CourseApplicationFileResidual courseApplicationFileApplication
|
||||
) -> CourseApplicationFile
|
||||
{ courseApplicationFileApplication
|
||||
, courseApplicationFileTitle = fileReferenceTitle
|
||||
, courseApplicationFileContent = fileReferenceContent
|
||||
, courseApplicationFileModified = fileReferenceModified
|
||||
}
|
||||
)
|
||||
|
||||
instance IsFileReference CourseApplicationFile where
|
||||
fileReferenceTitleField = CourseApplicationFileTitle
|
||||
fileReferenceContentField = CourseApplicationFileContent
|
||||
fileReferenceModifiedField = CourseApplicationFileModified
|
||||
|
||||
instance HasFileReference CourseAppInstructionFile where
|
||||
newtype FileReferenceResidual CourseAppInstructionFile
|
||||
= CourseAppInstructionFileResidual { courseAppInstructionFileResidualCourse :: CourseId }
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
|
||||
_FileReference
|
||||
= iso (\CourseAppInstructionFile{..} -> ( FileReference
|
||||
{ fileReferenceTitle = courseAppInstructionFileTitle
|
||||
, fileReferenceContent = courseAppInstructionFileContent
|
||||
, fileReferenceModified = courseAppInstructionFileModified
|
||||
}
|
||||
, CourseAppInstructionFileResidual courseAppInstructionFileCourse
|
||||
)
|
||||
)
|
||||
(\( FileReference{..}
|
||||
, CourseAppInstructionFileResidual courseAppInstructionFileCourse
|
||||
) -> CourseAppInstructionFile
|
||||
{ courseAppInstructionFileCourse
|
||||
, courseAppInstructionFileTitle = fileReferenceTitle
|
||||
, courseAppInstructionFileContent = fileReferenceContent
|
||||
, courseAppInstructionFileModified = fileReferenceModified
|
||||
}
|
||||
)
|
||||
|
||||
instance IsFileReference CourseAppInstructionFile where
|
||||
fileReferenceTitleField = CourseAppInstructionFileTitle
|
||||
fileReferenceContentField = CourseAppInstructionFileContent
|
||||
fileReferenceModifiedField = CourseAppInstructionFileModified
|
||||
|
||||
instance HasFileReference SheetFile where
|
||||
data FileReferenceResidual SheetFile = SheetFileResidual
|
||||
{ sheetFileResidualSheet :: SheetId
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
@ -55,16 +55,12 @@ _manualMigration = folding $ \case
|
||||
([Legacy.migrationVersion|13.0.0|], [Legacy.version|14.0.0|]) -> Just Migration20190715ExamOccurrenceName
|
||||
([Legacy.migrationVersion|14.0.0|], [Legacy.version|15.0.0|]) -> Just Migration20190726UserFirstNamesTitles
|
||||
([Legacy.migrationVersion|15.0.0|], [Legacy.version|16.0.0|]) -> Just Migration20190806TransactionLogIds
|
||||
([Legacy.migrationVersion|16.0.0|], [Legacy.version|17.0.0|]) -> Just Migration20190809AllocationIndependentApplication
|
||||
([Legacy.migrationVersion|17.0.0|], [Legacy.version|18.0.0|]) -> Just Migration20190813Allocations
|
||||
([Legacy.migrationVersion|18.0.0|], [Legacy.version|19.0.0|]) -> Just Migration20190828UserFunction
|
||||
([Legacy.migrationVersion|19.0.0|], [Legacy.version|20.0.0|]) -> Just Migration20190912UserDisplayEmail
|
||||
([Legacy.migrationVersion|20.0.0|], [Legacy.version|21.0.0|]) -> Just Migration20190916ExamPartNumber
|
||||
([Legacy.migrationVersion|21.0.0|], [Legacy.version|22.0.0|]) -> Just Migration20190918ExamRulesRefactor
|
||||
([Legacy.migrationVersion|22.0.0|], [Legacy.version|23.0.0|]) -> Just Migration20190919ExamBonusRounding
|
||||
([Legacy.migrationVersion|23.0.0|], [Legacy.version|24.0.0|]) -> Just Migration20191002FavouriteReason
|
||||
([Legacy.migrationVersion|24.0.0|], [Legacy.version|25.0.0|]) -> Just Migration20191003CourseParticipantAllocatedId
|
||||
([Legacy.migrationVersion|25.0.0|], [Legacy.version|26.0.0|]) -> Just Migration20191013AllocationMatching
|
||||
([Legacy.migrationVersion|26.0.0|], [Legacy.version|27.0.0|]) -> Just Migration20191125UserLanguages
|
||||
([Legacy.migrationVersion|27.0.0|], [Legacy.version|28.0.0|]) -> Just Migration20191126ExamPartCorrector
|
||||
([Legacy.migrationVersion|28.0.0|], [Legacy.version|29.0.0|]) -> Just Migration20191128StudyFeaturesSuperField
|
||||
@ -72,12 +68,10 @@ _manualMigration = folding $ \case
|
||||
([Legacy.migrationVersion|30.0.0|], [Legacy.version|31.0.0|]) -> Just Migration20200218ExamResultPassedGrade
|
||||
([Legacy.migrationVersion|31.0.0|], [Legacy.version|32.0.0|]) -> Just Migration20200218ExamGradingModeMixed
|
||||
([Legacy.migrationVersion|32.0.0|], [Legacy.version|33.0.0|]) -> Just Migration20200218ExternalExamGradingModeMixed
|
||||
([Legacy.migrationVersion|33.0.0|], [Legacy.version|34.0.0|]) -> Just Migration20200311AllocationMatching
|
||||
([Legacy.migrationVersion|34.0.0|], [Legacy.version|35.0.0|]) -> Just Migration20200424SubmissionGroups
|
||||
([Legacy.migrationVersion|35.0.0|], [Legacy.version|36.0.0|]) -> Just Migration20200504CourseParticipantState
|
||||
([Legacy.migrationVersion|36.0.0|], [Legacy.version|37.0.0|]) -> Just Migration20200506SessionFile
|
||||
([Legacy.migrationVersion|37.0.0|], [Legacy.version|38.0.0|]) -> Just Migration20200627FileRefactor
|
||||
([Legacy.migrationVersion|38.0.0|], [Legacy.version|39.0.0|]) -> Just Migration20200824AllocationNotifications
|
||||
([Legacy.migrationVersion|39.0.0|], [Legacy.version|40.0.0|]) -> Just Migration20200825StudyFeaturesFirstObserved
|
||||
([Legacy.migrationVersion|40.0.0|], [Legacy.version|41.0.0|]) -> Just Migration20200902FileChunking
|
||||
([Legacy.migrationVersion|41.0.0|], [Legacy.version|42.0.0|]) -> Just Migration20200916ExamMode
|
||||
|
||||
@ -15,28 +15,21 @@ import Model
|
||||
import Model.Types.TH.PathPiece
|
||||
import Settings
|
||||
import Foundation.Type
|
||||
import Jobs.Types
|
||||
import Audit.Types
|
||||
import qualified Model.Migration.Types as Legacy
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
|
||||
import qualified Data.Text as Text
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
import Data.Semigroup (Max(..), Last(..))
|
||||
|
||||
|
||||
import Database.Persist.Sql
|
||||
import Database.Persist.Sql.Raw.QQ
|
||||
|
||||
import Text.Read (readMaybe)
|
||||
|
||||
import Utils.Lens (_NoUpload)
|
||||
|
||||
import Network.IP.Addr
|
||||
|
||||
import qualified Data.Char as Char
|
||||
@ -73,16 +66,12 @@ data ManualMigration
|
||||
| Migration20190715ExamOccurrenceName
|
||||
| Migration20190726UserFirstNamesTitles
|
||||
| Migration20190806TransactionLogIds
|
||||
| Migration20190809AllocationIndependentApplication
|
||||
| Migration20190813Allocations
|
||||
| Migration20190828UserFunction
|
||||
| Migration20190912UserDisplayEmail
|
||||
| Migration20190916ExamPartNumber
|
||||
| Migration20190918ExamRulesRefactor
|
||||
| Migration20190919ExamBonusRounding
|
||||
| Migration20191002FavouriteReason
|
||||
| Migration20191003CourseParticipantAllocatedId
|
||||
| Migration20191013AllocationMatching
|
||||
| Migration20191125UserLanguages
|
||||
| Migration20191126ExamPartCorrector
|
||||
| Migration20191128StudyFeaturesSuperField
|
||||
@ -90,12 +79,10 @@ data ManualMigration
|
||||
| Migration20200218ExamResultPassedGrade
|
||||
| Migration20200218ExamGradingModeMixed
|
||||
| Migration20200218ExternalExamGradingModeMixed
|
||||
| Migration20200311AllocationMatching
|
||||
| Migration20200424SubmissionGroups
|
||||
| Migration20200504CourseParticipantState
|
||||
| Migration20200506SessionFile
|
||||
| Migration20200627FileRefactor
|
||||
| Migration20200824AllocationNotifications
|
||||
| Migration20200825StudyFeaturesFirstObserved
|
||||
| Migration20200902FileChunking
|
||||
| Migration20200916ExamMode
|
||||
@ -125,12 +112,9 @@ derivePersistFieldPathPiece ''ManualMigration
|
||||
migrateManual :: Migration
|
||||
migrateManual = do
|
||||
mapM_ (uncurry addIndex)
|
||||
[ ("course_application_file_content", "CREATE INDEX course_application_file_content ON course_application_file (content)" )
|
||||
, ("material_file_content", "CREATE INDEX material_file_content ON material_file (content)" )
|
||||
[ ("material_file_content", "CREATE INDEX material_file_content ON material_file (content)" )
|
||||
, ("course_news_file_content", "CREATE INDEX course_news_file_content ON course_news_file (content)" )
|
||||
, ("sheet_file_content", "CREATE INDEX sheet_file_content ON sheet_file (content)" )
|
||||
, ("course_app_instruction_file_content", "CREATE INDEX course_app_instruction_file_content ON course_app_instruction_file (content)")
|
||||
, ("allocation_matching_log", "CREATE INDEX allocation_matching_log ON allocation_matching (log)" )
|
||||
, ("submission_file_content", "CREATE INDEX submission_file_content ON submission_file (content)" )
|
||||
, ("session_file_content", "CREATE INDEX session_file_content ON session_file (content)" )
|
||||
, ("file_lock_content", "CREATE INDEX file_lock_content ON file_lock (content)" )
|
||||
@ -414,57 +398,6 @@ customMigrations = mapF $ \case
|
||||
updateTransactionInfo _ = return ()
|
||||
runConduit $ getLogEntries .| C.mapM_ updateTransactionInfo
|
||||
|
||||
Migration20190809AllocationIndependentApplication -> do
|
||||
whenM (tableExists "allocation_course") $ do
|
||||
vals <- [sqlQQ| SELECT "course", "instructions", "application_text", "application_files", "ratings_visible" FROM "allocation_course"; |]
|
||||
|
||||
whenM (tableExists "course") $ do
|
||||
[executeQQ|
|
||||
ALTER TABLE "course" ADD COLUMN "applications_required" boolean not null default #{False}, ADD COLUMN "applications_instructions" varchar null, ADD COLUMN "applications_text" boolean not null default #{False}, ADD COLUMN "applications_files" jsonb not null default #{NoUpload}, ADD COLUMN "applications_ratings_visible" boolean not null default #{False};
|
||||
ALTER TABLE "course" ALTER COLUMN "applications_required" DROP DEFAULT, ALTER COLUMN "applications_text" DROP DEFAULT, ALTER COLUMN "applications_files" DROP DEFAULT, ALTER COLUMN "applications_ratings_visible" DROP DEFAULT;
|
||||
|]
|
||||
|
||||
forM_ vals $ \(cid :: CourseId, Single applicationsInstructions :: Single (Maybe Html), Single applicationsText :: Single Bool, Single applicationsFiles :: Single UploadMode, Single applicationsRatingsVisible :: Single Bool) -> do
|
||||
let appRequired = applicationsText || isn't _NoUpload applicationsFiles
|
||||
[executeQQ|
|
||||
UPDATE "course" SET ("applications_required", "applications_instructions", "applications_text", "applications_files", "applications_ratings_visible") = (#{appRequired}, #{applicationsInstructions}, #{applicationsText}, #{applicationsFiles}, #{applicationsRatingsVisible}) WHERE "id" = #{cid};
|
||||
|]
|
||||
|
||||
[executeQQ|
|
||||
ALTER TABLE "allocation_course" DROP COLUMN "instructions", DROP COLUMN "application_text", DROP COLUMN "application_files", DROP COLUMN "ratings_visible";
|
||||
|]
|
||||
|
||||
whenM ((&&) <$> tableExists "allocation_course_file" <*> (not <$> tableExists "course_app_instruction_file")) $ do
|
||||
[executeQQ|
|
||||
CREATE TABLE "course_app_instruction_file"("id" SERIAL8 PRIMARY KEY UNIQUE,"course" INT8 NOT NULL,"file" INT8 NOT NULL);
|
||||
ALTER TABLE "course_app_instruction_file" ADD CONSTRAINT "unique_course_app_instruction_file" UNIQUE("course","file");
|
||||
ALTER TABLE "course_app_instruction_file" ADD CONSTRAINT "course_app_instruction_file_course_fkey" FOREIGN KEY("course") REFERENCES "course"("id");
|
||||
ALTER TABLE "course_app_instruction_file" ADD CONSTRAINT "course_app_instruction_file_file_fkey" FOREIGN KEY("file") REFERENCES "file"("id");
|
||||
|]
|
||||
|
||||
let getFileEntries = rawQuery [st|SELECT "allocation_course_file"."id", "allocation_course"."course", "allocation_course_file"."file" FROM "allocation_course_file" INNER JOIN "allocation_course" ON "allocation_course"."id" = "allocation_course_file"."allocation_course"|] []
|
||||
moveFileEntry [fromPersistValue -> Right (acfId :: Int64), fromPersistValue -> Right (cid :: CourseId), fromPersistValue -> Right (fid :: Int64)] =
|
||||
[executeQQ|
|
||||
INSERT INTO "course_app_instruction_file" ("course", "file") VALUES (#{cid}, #{fid});
|
||||
DELETE FROM "allocation_course_file" WHERE "id" = #{acfId};
|
||||
|]
|
||||
moveFileEntry _ = return ()
|
||||
runConduit $ getFileEntries .| C.mapM_ moveFileEntry
|
||||
tableDropEmpty "allocation_course_file"
|
||||
|
||||
whenM (tableExists "allocation_application") $
|
||||
tableDropEmpty "allocation_application"
|
||||
whenM (tableExists "allocation_application_file") $
|
||||
tableDropEmpty "allocation_application_file"
|
||||
|
||||
Migration20190813Allocations -> do
|
||||
whenM (tableExists "allocation") $ do
|
||||
[executeQQ|ALTER TABLE allocation DROP COLUMN IF EXISTS capacity;|]
|
||||
[executeQQ|ALTER TABLE allocation DROP COLUMN IF EXISTS link_external;|]
|
||||
[executeQQ|ALTER TABLE allocation DROP COLUMN IF EXISTS register_secret;|]
|
||||
whenM (tableExists "allocation_deregister") $ do
|
||||
[executeQQ|ALTER TABLE allocation_deregister DROP COLUMN IF EXISTS allocation;|]
|
||||
|
||||
Migration20190828UserFunction -> do
|
||||
[executeQQ|
|
||||
CREATE TABLE IF NOT EXISTS "user_function" ( "id" serial8 primary key, "user" bigint, "school" citext, "function" text );
|
||||
@ -565,24 +498,6 @@ customMigrations = mapF $ \case
|
||||
ALTER TABLE "course_favourite" ADD COLUMN "reason" jsonb DEFAULT '"visited"'::jsonb;
|
||||
|]
|
||||
|
||||
Migration20191003CourseParticipantAllocatedId -> whenM (tableExists "course_participant") $ do
|
||||
queryRes <- [sqlQQ|SELECT (EXISTS (SELECT 1 FROM "course_participant" WHERE "allocated" <> false))|]
|
||||
case queryRes of
|
||||
[Single False] ->
|
||||
[executeQQ|
|
||||
ALTER TABLE "course_participant" DROP COLUMN "allocated";
|
||||
ALTER TABLE "course_participant" ADD COLUMN "allocated" bigint;
|
||||
|]
|
||||
_other -> error "Cannot reconstruct course_participant.allocated"
|
||||
|
||||
Migration20191013AllocationMatching -> whenM (tableExists "allocation")
|
||||
[executeQQ|
|
||||
CREATE TABLE "allocation_matching" ("id" SERIAL8 PRIMARY KEY UNIQUE, "allocation" INT8 NOT NULL, "fingerprint" BYTEA NOT NULL, "log" INT8 NOT NULL);
|
||||
INSERT INTO "allocation_matching" ("allocation", "fingerprint", "log") (select "id" as "allocation", "fingerprint", "matching_log" as "log" from "allocation" where not ("matching_log" is null) and not ("fingerprint" is null));
|
||||
ALTER TABLE "allocation" DROP COLUMN "fingerprint";
|
||||
ALTER TABLE "allocation" DROP COLUMN "matching_log";
|
||||
|]
|
||||
|
||||
Migration20191125UserLanguages -> whenM (tableExists "user")
|
||||
[executeQQ|
|
||||
ALTER TABLE "user" ADD COLUMN "languages" jsonb;
|
||||
@ -631,9 +546,6 @@ customMigrations = mapF $ \case
|
||||
ALTER TABLE "external_exam" ALTER COLUMN "grading_mode" SET NOT NULL;
|
||||
|]
|
||||
|
||||
Migration20200311AllocationMatching -> whenM (tableExists "allocation_matching") $
|
||||
tableDropEmpty "allocation_matching"
|
||||
|
||||
Migration20200424SubmissionGroups -> do
|
||||
whenM (tableExists "submission_group") $
|
||||
tableDropEmpty "submission_group"
|
||||
@ -648,11 +560,8 @@ customMigrations = mapF $ \case
|
||||
let getAuditLog = rawQuery [st|SELECT DISTINCT ON ("info") "info", max("time") FROM "transaction_log" GROUP BY "info" ORDER BY "info";|] []
|
||||
ensureParticipant :: [PersistValue] -> ReaderT SqlBackend m ()
|
||||
ensureParticipant [fmap Aeson.fromJSON . fromPersistValue -> Right (Aeson.Success TransactionCourseParticipantEdit{..}), fromPersistValue -> Right (time :: UTCTime)] = do
|
||||
let toAllocated :: [[PersistValue]] -> Maybe AllocationId
|
||||
toAllocated = either (const Nothing) Just . fromPersistValue <=< listToMaybe <=< listToMaybe
|
||||
allocated <- toAllocated <$> sourceToList [queryQQ|SELECT "allocation_course".allocation FROM "allocation_deregister" INNER JOIN "allocation_course" ON "allocation_course".course = "allocation_deregister".course WHERE "user" = #{transactionUser} AND "allocation_course"."course" = #{transactionCourse} LIMIT 1;|]
|
||||
whenM (existsKey transactionCourse `and2M` existsKey transactionUser)
|
||||
[executeQQ|INSERT INTO "course_participant" ("course", "user", "registration", "state", "allocated") VALUES (#{transactionCourse}, #{transactionUser}, #{time}, #{CourseParticipantInactive False}, #{allocated}) ON CONFLICT DO NOTHING;|]
|
||||
[executeQQ|INSERT INTO "course_participant" ("course", "user", "registration", "state") VALUES (#{transactionCourse}, #{transactionUser}, #{time}, #{CourseParticipantInactive False}) ON CONFLICT DO NOTHING;|]
|
||||
ensureParticipant _ = return ()
|
||||
runConduit $ getAuditLog .| C.mapM_ ensureParticipant
|
||||
|
||||
@ -732,25 +641,6 @@ customMigrations = mapF $ \case
|
||||
ALTER TABLE "sheet_file" DROP COLUMN "file";
|
||||
|]
|
||||
|
||||
whenM (tableExists "course_app_instruction_file") $ do
|
||||
[executeQQ|
|
||||
ALTER TABLE "course_app_instruction_file" ADD COLUMN "title" VARCHAR;
|
||||
ALTER TABLE "course_app_instruction_file" ADD COLUMN "content" BYTEA NULL;
|
||||
ALTER TABLE "course_app_instruction_file" ADD COLUMN "modified" TIMESTAMP WITH TIME ZONE;
|
||||
ALTER TABLE "course_app_instruction_file" DROP CONSTRAINT "unique_course_app_instruction_file";
|
||||
ALTER TABLE "course_app_instruction_file" ADD CONSTRAINT "unique_course_app_instruction_file" UNIQUE("course", "title");
|
||||
|]
|
||||
let getCourseAppInstructionFiles = [queryQQ|SELECT "file", "course_app_instruction_file"."id", "course" FROM "course_app_instruction_file" LEFT OUTER JOIN "file" ON "course_app_instruction_file"."file" = "file".id ORDER BY "file"."modified" DESC;|]
|
||||
toResidual [ fromPersistValue -> Right caifId
|
||||
, fromPersistValue -> Right courseAppInstructionFileResidualCourse
|
||||
]
|
||||
= (caifId, CourseAppInstructionFileResidual{..})
|
||||
toResidual _ = error "Could not convert CourseAppInstructionFile to residual"
|
||||
runConduit $ getCourseAppInstructionFiles .| C.mapM_ (migrateFromFile @CourseAppInstructionFile toResidual replaceEntity)
|
||||
[executeQQ|
|
||||
ALTER TABLE "course_app_instruction_file" DROP COLUMN "file";
|
||||
|]
|
||||
|
||||
whenM (tableExists "course_news_file") $ do
|
||||
[executeQQ|
|
||||
ALTER TABLE "course_news_file" ADD COLUMN "title" VARCHAR;
|
||||
@ -789,33 +679,6 @@ customMigrations = mapF $ \case
|
||||
ALTER TABLE "material_file" DROP COLUMN "file";
|
||||
|]
|
||||
|
||||
whenM (tableExists "course_application_file") $ do
|
||||
[executeQQ|
|
||||
ALTER TABLE "course_application_file" ADD COLUMN "title" VARCHAR;
|
||||
ALTER TABLE "course_application_file" ADD COLUMN "content" BYTEA NULL;
|
||||
ALTER TABLE "course_application_file" ADD COLUMN "modified" TIMESTAMP WITH TIME ZONE;
|
||||
ALTER TABLE "course_application_file" DROP CONSTRAINT "unique_application_file";
|
||||
ALTER TABLE "course_application_file" ADD CONSTRAINT "unique_course_application_file" UNIQUE("application", "title");
|
||||
|]
|
||||
let getCourseApplicationFiles = [queryQQ|SELECT "file", "course_application_file"."id", "application" FROM "course_application_file" LEFT OUTER JOIN "file" ON "course_application_file"."file" = "file".id ORDER BY "file"."modified" DESC;|]
|
||||
toResidual [ fromPersistValue -> Right cnfId
|
||||
, fromPersistValue -> Right courseApplicationFileResidualApplication
|
||||
]
|
||||
= (cnfId, CourseApplicationFileResidual{..})
|
||||
toResidual _ = error "Could not convert CourseApplicationFile to residual"
|
||||
runConduit $ getCourseApplicationFiles .| C.mapM_ (migrateFromFile @CourseApplicationFile toResidual replaceEntity)
|
||||
[executeQQ|
|
||||
ALTER TABLE "course_application_file" DROP COLUMN "file";
|
||||
|]
|
||||
|
||||
whenM (tableExists "allocation_matching") $ do
|
||||
[executeQQ|
|
||||
ALTER TABLE "allocation_matching" ADD COLUMN "log_ref" BYTEA;
|
||||
UPDATE "allocation_matching" SET "log_ref" = (SELECT "hash" FROM "file" WHERE "file".id = "log");
|
||||
ALTER TABLE "allocation_matching" DROP COLUMN "log";
|
||||
ALTER TABLE "allocation_matching" RENAME COLUMN "log_ref" TO "log";
|
||||
|]
|
||||
|
||||
whenM (tableExists "session_file")
|
||||
[executeQQ|
|
||||
ALTER TABLE "session_file" ADD COLUMN "content" BYTEA;
|
||||
@ -850,31 +713,6 @@ customMigrations = mapF $ \case
|
||||
ALTER TABLE "file_content" DROP COLUMN "id";
|
||||
|]
|
||||
|
||||
Migration20200824AllocationNotifications -> whenM (and2M (tableExists "cron_last_exec") (tableExists "allocation")) $ do
|
||||
let
|
||||
allocationTimes :: EntityField Allocation (Maybe UTCTime)
|
||||
-> ReaderT SqlBackend m (MergeHashMap UTCTime (Set AllocationId, Max UTCTime, Last InstanceId))
|
||||
allocationTimes aField = do
|
||||
ress <- [sqlQQ|SELECT ^{Allocation}.@{AllocationId},^{Allocation}.@{aField},^{CronLastExec}.@{CronLastExecTime},^{CronLastExec}.@{CronLastExecInstance} FROM ^{Allocation} INNER JOIN ^{CronLastExec} ON ^{CronLastExec}.@{CronLastExecJob}->'job' = '"queue-notification"' AND ^{CronLastExec}.@{CronLastExecJob}->'notification'->'notification' = '"allocation-staff-register"' AND ^{CronLastExec}.@{CronLastExecJob}->'notification'->'allocation' = (^{Allocation}.@{AllocationId} :: text) :: jsonb ORDER BY ^{Allocation}.@{aField} ASC;|]
|
||||
return . flip foldMap ress $ \(Single allocId, Single allocTime, Single execTime, Single execInstance)
|
||||
-> _MergeHashMap # HashMap.singleton allocTime (Set.singleton allocId, Max execTime, Last execInstance)
|
||||
|
||||
staffRegisterFroms <- allocationTimes AllocationStaffRegisterFrom
|
||||
forM_ staffRegisterFroms $ \(nAllocations, Max cronLastExecTime, Last cronLastExecInstance) ->
|
||||
insert_ CronLastExec{ cronLastExecJob = toJSON $ JobQueueNotification NotificationAllocationStaffRegister{..}, .. }
|
||||
|
||||
registerFroms <- allocationTimes AllocationRegisterFrom
|
||||
forM_ registerFroms $ \(nAllocations, Max cronLastExecTime, Last cronLastExecInstance) ->
|
||||
insert_ CronLastExec{ cronLastExecJob = toJSON $ JobQueueNotification NotificationAllocationRegister{..}, .. }
|
||||
|
||||
staffAllocationFroms <- allocationTimes AllocationStaffAllocationFrom
|
||||
forM_ staffAllocationFroms $ \(nAllocations, Max cronLastExecTime, Last cronLastExecInstance) ->
|
||||
insert_ CronLastExec{ cronLastExecJob = toJSON $ JobQueueNotification NotificationAllocationAllocation{..}, .. }
|
||||
|
||||
registerTos <- allocationTimes AllocationRegisterTo
|
||||
forM_ registerTos $ \(nAllocations, Max cronLastExecTime, Last cronLastExecInstance) ->
|
||||
insert_ CronLastExec{ cronLastExecJob = toJSON $ JobQueueNotification NotificationAllocationUnratedApplications{..}, .. }
|
||||
|
||||
Migration20200825StudyFeaturesFirstObserved -> whenM (tableExists "study_features")
|
||||
[executeQQ|
|
||||
ALTER TABLE study_features RENAME updated TO last_observed;
|
||||
@ -913,10 +751,7 @@ customMigrations = mapF $ \case
|
||||
Migration20201106StoredMarkup ->
|
||||
[executeQQ|
|
||||
SET client_min_messages TO WARNING;
|
||||
ALTER TABLE IF EXISTS ^{Allocation} ALTER COLUMN @{AllocationDescription} TYPE jsonb USING (CASE WHEN @{AllocationDescription} IS NOT NULL THEN to_json(@{AllocationDescription}) ELSE NULL END);
|
||||
ALTER TABLE IF EXISTS ^{Allocation} ALTER COLUMN @{AllocationStaffDescription} TYPE jsonb USING (CASE WHEN @{AllocationStaffDescription} IS NOT NULL THEN to_json(@{AllocationStaffDescription}) ELSE NULL END);
|
||||
ALTER TABLE IF EXISTS ^{Course} ALTER COLUMN @{CourseDescription} TYPE jsonb USING (CASE WHEN @{CourseDescription} IS NOT NULL THEN to_json(@{CourseDescription}) ELSE NULL END);
|
||||
ALTER TABLE IF EXISTS ^{Course} ALTER COLUMN @{CourseApplicationsInstructions} TYPE jsonb USING (CASE WHEN @{CourseApplicationsInstructions} IS NOT NULL THEN to_json(@{CourseApplicationsInstructions}) ELSE NULL END);
|
||||
ALTER TABLE IF EXISTS ^{CourseEvent} ALTER COLUMN @{CourseEventNote} TYPE jsonb USING (CASE WHEN @{CourseEventNote} IS NOT NULL THEN to_json(@{CourseEventNote}) ELSE NULL END);
|
||||
ALTER TABLE IF EXISTS ^{CourseUserNote} ALTER COLUMN @{CourseUserNoteNote} TYPE jsonb USING (CASE WHEN @{CourseUserNoteNote} IS NOT NULL THEN to_json(@{CourseUserNoteNote}) ELSE NULL END);
|
||||
ALTER TABLE IF EXISTS ^{Material} ALTER COLUMN @{MaterialDescription} TYPE jsonb USING (CASE WHEN @{MaterialDescription} IS NOT NULL THEN to_json(@{MaterialDescription}) ELSE NULL END);
|
||||
|
||||
@ -18,7 +18,6 @@ import Model.Types.Sheet as Types
|
||||
import Model.Types.Submission as Types
|
||||
import Model.Types.Misc as Types
|
||||
import Model.Types.School as Types
|
||||
import Model.Types.Allocation as Types
|
||||
import Model.Types.Languages as Types
|
||||
import Model.Types.Apis as Types
|
||||
import Model.Types.File as Types
|
||||
|
||||
@ -1,103 +0,0 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Model.Types.Allocation
|
||||
( AllocationPriority(..)
|
||||
, sqlAllocationPriorityNumeric
|
||||
, AllocationPriorityComparison(..)
|
||||
, AllocationFingerprint
|
||||
, module Utils.Allocation
|
||||
, AllocationPriorityNumericRecord(..)
|
||||
, allocationPriorityNumericMap
|
||||
) where
|
||||
|
||||
import Import.NoModel
|
||||
import Utils.Allocation (MatchingLog(..))
|
||||
import Model.Types.Common
|
||||
|
||||
import qualified Data.Csv as Csv
|
||||
import qualified Data.Vector as Vector
|
||||
|
||||
import qualified Data.Map.Strict as Map
|
||||
|
||||
import Crypto.Hash (SHAKE128)
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.Internal.Internal as E
|
||||
import qualified Database.Esqueleto.PostgreSQL.JSON as E
|
||||
|
||||
import qualified Data.Text as Text
|
||||
|
||||
{-# ANN module ("HLint: ignore Use newtype instead of data"::String) #-}
|
||||
|
||||
|
||||
data AllocationPriority
|
||||
= AllocationPriorityNumeric { allocationPriorities :: Vector Integer }
|
||||
| AllocationPriorityOrdinal { allocationOrdinal :: Natural }
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
deriving anyclass (NFData)
|
||||
deriveJSON defaultOptions
|
||||
{ fieldLabelModifier = camelToPathPiece' 1
|
||||
, constructorTagModifier = camelToPathPiece' 2
|
||||
, allNullaryToStringTag = False
|
||||
, sumEncoding = TaggedObject "mode" "value"
|
||||
, unwrapUnaryRecords = False
|
||||
, tagSingleConstructors = True
|
||||
} ''AllocationPriority
|
||||
|
||||
deriving via E.JSONB AllocationPriority instance E.PersistField AllocationPriority
|
||||
deriving via E.JSONB AllocationPriority instance E.PersistFieldSql AllocationPriority
|
||||
|
||||
instance Binary AllocationPriority
|
||||
|
||||
data AllocationPriorityNumericRecord = AllocationPriorityNumericRecord
|
||||
{ apmrMatrikelnummer :: UserMatriculation
|
||||
, apmrPriority :: Vector Integer
|
||||
}
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
deriving anyclass (NFData)
|
||||
|
||||
allocationPriorityNumericMap :: Prism' (Map UserMatriculation AllocationPriority) AllocationPriorityNumericRecord
|
||||
allocationPriorityNumericMap = prism' fromPrioRecord toPrioRecord
|
||||
where
|
||||
fromPrioRecord AllocationPriorityNumericRecord{..}
|
||||
= Map.singleton apmrMatrikelnummer $ AllocationPriorityNumeric apmrPriority
|
||||
|
||||
toPrioRecord recordMap = do
|
||||
[(matr, AllocationPriorityNumeric{..})] <- pure $ Map.toList recordMap
|
||||
return $ AllocationPriorityNumericRecord matr allocationPriorities
|
||||
|
||||
instance Csv.FromRecord AllocationPriorityNumericRecord where
|
||||
parseRecord v = parseNumeric
|
||||
where
|
||||
parseNumeric
|
||||
| Vector.length v >= 1 = AllocationPriorityNumericRecord <$> v Csv..! 0 <*> mapM Csv.parseField (Vector.tail v)
|
||||
| otherwise = mzero
|
||||
|
||||
instance Csv.ToRecord AllocationPriorityNumericRecord where
|
||||
toRecord AllocationPriorityNumericRecord{..} = Csv.record $
|
||||
Csv.toField apmrMatrikelnummer
|
||||
: map Csv.toField (otoList apmrPriority)
|
||||
|
||||
instance Csv.FromRecord (Map UserMatriculation AllocationPriority) where
|
||||
parseRecord = fmap (review allocationPriorityNumericMap) . Csv.parseRecord
|
||||
|
||||
|
||||
instance Csv.ToField AllocationPriority where
|
||||
toField (AllocationPriorityOrdinal n ) = Csv.toField n
|
||||
toField (AllocationPriorityNumeric ns) = encodeUtf8 . (\ns' -> "[" <> ns' <> "]") . Text.intercalate "," . map tshow $ Vector.toList ns
|
||||
|
||||
|
||||
sqlAllocationPriorityNumeric :: E.SqlExpr (E.Value AllocationPriority) -> E.SqlExpr (E.Value Bool)
|
||||
sqlAllocationPriorityNumeric prio = E.veryUnsafeCoerceSqlExprValue prio E.->. "mode" E.==. E.jsonbVal ("numeric" :: Text)
|
||||
|
||||
|
||||
data AllocationPriorityComparison
|
||||
= AllocationPriorityComparisonNumeric { allocationGradeScale :: Rational }
|
||||
| AllocationPriorityComparisonOrdinal { allocationCloneIndex :: Down Natural, allocationOrdinalScale :: Rational }
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
deriving anyclass (NFData)
|
||||
|
||||
|
||||
type AllocationFingerprint = Digest (SHAKE128 128)
|
||||
@ -41,7 +41,6 @@ classifyChangelogItem = \case
|
||||
ChangelogErrorMessagesForTableItemVanish -> ChangelogItemBugfix
|
||||
ChangelogExamAchievementParticipantDuplication -> ChangelogItemBugfix
|
||||
ChangelogFormsTimesReset -> ChangelogItemBugfix
|
||||
ChangelogAllocationCourseAcceptSubstitutesFixed -> ChangelogItemBugfix
|
||||
ChangelogStoredMarkup -> ChangelogItemBugfix
|
||||
ChangelogFixPersonalisedSheetFilesKeep -> ChangelogItemBugfix
|
||||
ChangelogHonorRoomHidden -> ChangelogItemBugfix
|
||||
@ -90,13 +89,8 @@ changelogItemDays = Map.fromListWithKey (\k d1 d2 -> bool (error $ "Duplicate ch
|
||||
, (ChangelogSheetSpecificFiles, [day|2019-06-07|])
|
||||
, (ChangelogExams, [day|2019-06-26|])
|
||||
, (ChangelogCsvExamParticipants, [day|2019-07-23|])
|
||||
, (ChangelogAllocationCourseRegistration, [day|2019-08-12|])
|
||||
, (ChangelogAllocationApplications, [day|2019-08-19|])
|
||||
, (ChangelogCsvCourseApplications, [day|2019-08-27|])
|
||||
, (ChangelogAllocationsNotifications, [day|2019-09-05|])
|
||||
, (ChangelogConfigurableDisplayEmails, [day|2019-09-12|])
|
||||
, (ChangelogConfigurableDisplayNames, [day|2019-09-12|])
|
||||
, (ChangelogEstimateAllocatedCourseCapacity, [day|2019-09-12|])
|
||||
, (ChangelogNotificationExamRegistration, [day|2019-09-13|])
|
||||
, (ChangelogExamClosure, [day|2019-09-16|])
|
||||
, (ChangelogExamOfficeExamNotification, [day|2019-09-16|])
|
||||
@ -105,7 +99,6 @@ changelogItemDays = Map.fromListWithKey (\k d1 d2 -> bool (error $ "Duplicate ch
|
||||
, (ChangelogFormsTimesReset, [day|2019-09-25|])
|
||||
, (ChangelogExamAutomaticResults, [day|2019-09-25|])
|
||||
, (ChangelogExamAutomaticBoni, [day|2019-09-25|])
|
||||
, (ChangelogAutomaticallyAcceptCourseApplications, [day|2019-09-27|])
|
||||
, (ChangelogCourseNews, [day|2019-10-01|])
|
||||
, (ChangelogCsvExportCourseParticipants, [day|2019-10-08|])
|
||||
, (ChangelogNotificationCourseParticipantViaAdmin, [day|2019-10-08|])
|
||||
@ -134,7 +127,6 @@ changelogItemDays = Map.fromListWithKey (\k d1 d2 -> bool (error $ "Duplicate ch
|
||||
, (ChangelogBetterCsvImport, [day|2020-03-06|])
|
||||
, (ChangelogAdditionalDatetimeFormats, [day|2020-03-16|])
|
||||
, (ChangelogServerSideSessions, [day|2020-03-16|])
|
||||
, (ChangelogWebinterfaceAllocationAllocation, [day|2020-03-16|])
|
||||
, (ChangelogBetterTableCellColourCoding, [day|2020-03-16|])
|
||||
, (ChangelogCourseOccurrenceNotes, [day|2020-03-31|])
|
||||
, (ChangelogHideSystemMessages, [day|2020-04-15|])
|
||||
|
||||
@ -55,9 +55,6 @@ type ExamName = CI Text
|
||||
type ExamPartName = CI Text
|
||||
type ExamOccurrenceName = CI Text
|
||||
|
||||
type AllocationName = CI Text
|
||||
type AllocationShorthand = CI Text
|
||||
|
||||
type PWHashAlgorithm = ByteString -> PWStore.Salt -> Int -> ByteString
|
||||
|
||||
type InstanceId = UUID
|
||||
|
||||
@ -57,13 +57,6 @@ data NotificationTrigger
|
||||
| NTExamRegistrationSoonInactive
|
||||
| NTExamDeregistrationSoonInactive
|
||||
| NTExamResult
|
||||
| NTAllocationStaffRegister
|
||||
| NTAllocationAllocation
|
||||
| NTAllocationRegister
|
||||
| NTAllocationNewCourse
|
||||
| NTAllocationOutdatedRatings
|
||||
| NTAllocationUnratedApplications
|
||||
| NTAllocationResults
|
||||
| NTExamOfficeExamResults
|
||||
| NTExamOfficeExamResultsChanged
|
||||
| NTCourseRegistered
|
||||
@ -88,7 +81,6 @@ instance Default NotificationSettings where
|
||||
defaultOff = HashSet.fromList
|
||||
[ NTSheetSoonInactive
|
||||
, NTExamRegistrationSoonInactive
|
||||
, NTAllocationNewCourse
|
||||
]
|
||||
|
||||
instance ToJSON NotificationSettings where
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user