Merge branch 'master' into version-bumps
This commit is contained in:
Gregor Kleen
commit
eb0aeeadbb
@ -53,6 +53,9 @@ RegisterTo: Anmeldungen bis
|
||||
DeRegUntil: Abmeldungen bis
|
||||
RegisterRetry: Sie wurden noch nicht angemeldet. Drücken Sie dazu den Knopf "Anmelden"
|
||||
|
||||
CourseVisibleFrom: Sichtbar ab
|
||||
CourseVisibleTo: Sichtbar bis
|
||||
|
||||
CourseRegistrationInterval: Anmeldung
|
||||
CourseDirectRegistrationInterval: Direkte Anmeldung
|
||||
CourseDeregisterUntil time@Text: Abmeldung nur bis #{time}
|
||||
@ -112,6 +115,9 @@ CourseNoCapacity: In diesem Kurs sind keine Plätze mehr frei.
|
||||
TutorialNoCapacity: In dieser Übung sind keine Plätze mehr frei.
|
||||
ExamOccurrenceNoCapacity: Zu diesem Termin/Raum sind keine Plätze mehr frei.
|
||||
CourseNotEmpty: In diesem Kurs sind momentan Teilnehmer angemeldet.
|
||||
CourseVisibility: Sichtbarkeit
|
||||
CourseInvisible: Dieser Kurs ist momentan nur für Dozenten, Assistenten, Tutoren, Korrektoren, angemeldete Teilnehmer und Bewerber 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 Dozenten, Assistenten, Tutoren, Korrektoren, angemeldete Teilnehmer und Bewerber sichtbar.
|
||||
CourseRegistration: Kursanmeldung
|
||||
CourseRegisterOpen: Anmeldung möglich
|
||||
CourseRegisterOk: Erfolgreich zum Kurs angemeldet
|
||||
@ -158,6 +164,8 @@ CourseSchoolShort: Institut
|
||||
CourseSchoolMultipleTip: Es stehen für Sie mehrere Institute zur Auswahl. Stellen Sie bitte sicher, dass Sie das für den Kurs korrekte Institut wählen.
|
||||
CourseSecretTip: Anmeldung zum Kurs erfordert Eingabe des Passworts, sofern gesetzt
|
||||
CourseSecretFormat: beliebige Zeichenkette
|
||||
CourseVisibleFromTip: Ab diesem Zeitpunkt ist der Kurs für andere Nutzer sichtbar. Ohne Datum ist der Kurs nie für andere Nutzer sichtbar. Dozenten, Assistenten, Tutoren, Korrektoren, angemeldete Teilnehmer sowie Bewerber dieses Kurses sind nicht betroffen. Nimmt der Kurs an einer Zentralanmeldung teil wird die Kurssichtbarkeit während der Bewerbungsphase forciert.
|
||||
CourseVisibleToTip: Der Kurs ist ab "Sichtbar ab" bis zu diesem Zeitpunkt für andere Nutzer sichtbar. Ohne Datum bleibt ein sichtbarer Kurs unbegrenzt sichtbar.
|
||||
CourseRegisterFromTip: Ohne Datum ist keine eigenständige Anmeldung von Studierenden erlaubt.
|
||||
CourseRegisterToTip: Darf auch unbegrenzt offen bleiben
|
||||
CourseDeregisterUntilTip: Abmeldung ist ab "Anmeldungen von" bis zu diesem Zeitpunkt erlaubt. Die Abmeldung darf auch unbegrenzt erlaubt bleiben.
|
||||
@ -263,6 +271,7 @@ CourseLecturerEmail: E-Mail
|
||||
CourseLecturer: Dozent
|
||||
CourseAssistant: Assistent
|
||||
CourseLecturerAlreadyAdded: Dieser Nutzer ist bereits als Kursverwalter eingetragen
|
||||
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
|
||||
CourseUserMustBeLecturer: Aktueller Benutzer muss als Kursverwalter eingetragen sein
|
||||
@ -270,6 +279,7 @@ CourseAllocationRequiresCapacity: Bei Teilnahme an einer Zentralanmeldung muss e
|
||||
CourseAllocationTermMustMatch: Kurs-Semester muss mit Semester der Zentralanmeldung übereinstimmen
|
||||
CourseAllocationCapacityMayNotBeChanged: Kapazität eines Kurses, der an einer Zentralanmeldung teilnimmt, darf nicht nachträglich 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).
|
||||
|
||||
CourseLecturerRightsIdentical: Alle Sorten von Kursverwalter haben identische Rechte.
|
||||
|
||||
@ -468,7 +478,8 @@ UnauthorizedParticipant: Angegebener Benutzer ist nicht als Teilnehmer dieser Ve
|
||||
UnauthorizedParticipantSelf: Sie sind kein Teilnehmer dieser Veranstaltung.
|
||||
UnauthorizedApplicant: Angegebener Benutzer hat sich nicht für diese Veranstaltung beworben.
|
||||
UnauthorizedApplicantSelf: Sie sind kein Bewerber für diese Veranstaltung.
|
||||
UnauthorizedCourseTime: Dieses Kurs erlaubt momentan keine Anmeldungen.
|
||||
UnauthorizedCourseTime: Dieser Kurs ist momentan nicht freigegeben.
|
||||
UnauthorizedCourseRegistrationTime: Dieses 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.
|
||||
@ -1440,6 +1451,7 @@ AuthTagTutorControl: Tutoren 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 ist Kursteilnehmer
|
||||
AuthTagAllocationRegistered: Nutzer nimmt an der Zentralanmeldung teil
|
||||
AuthTagTutorialRegistered: Nutzer ist Tutoriumsteilnehmer
|
||||
@ -2367,6 +2379,7 @@ CourseDeregisterNoShow: „Nicht erschienen“ bei Abmeldung
|
||||
CourseDeregisterNoShowTip: Soll, wenn sich Teilnehmer selbstständig abmelden, 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 haben Sie die Möglichkeit dies zu unterbinden, wenn der Studierende gute Gründe vorweisen kann, warum seine Abmeldung nicht selbstverschuldet ist.
|
||||
CourseDeregistrationFromInvisibleCourse: Dieser Kurs ist nur für angemeldete Teilnehmer und Bewerber sichtbar. Wenn Sie sich jetzt abmelden, können Sie danach nicht wieder auf den Kurs zugreifen!
|
||||
|
||||
MailSubjectAllocationResults allocation@AllocationName: Plätze für Zentralanmeldung „#{allocation}“ wurden verteilt
|
||||
AllocationResultsLecturer: Im Rahmen der oben genannten Zentralanmeldung wurden Plätze zugewiesen, wie folgt:
|
||||
@ -2670,4 +2683,4 @@ CorrUploadSubmissionDoneModeTip: Sollen hochgeladene Korrekturen als abgeschloss
|
||||
|
||||
AdminCrontabNotGenerated: (Noch) keine Crontab generiert
|
||||
CronMatchAsap: ASAP
|
||||
CronMatchNone: Nie
|
||||
CronMatchNone: Nie
|
||||
|
||||
@ -53,6 +53,9 @@ RegisterTo: Enrolment ends
|
||||
DeRegUntil: Deregistration until
|
||||
RegisterRetry: You haven't been enrolled. Press "Enrol for course" to enrol
|
||||
|
||||
CourseVisibleFrom: Visible from
|
||||
CourseVisibleTo: Visible to
|
||||
|
||||
CourseRegistrationInterval: Enrolment
|
||||
CourseDirectRegistrationInterval: Direct enrolment
|
||||
CourseDeregisterUntil time: Deregistration only until #{time}
|
||||
@ -112,6 +115,9 @@ CourseNoCapacity: Course has reached maximum capacity
|
||||
TutorialNoCapacity: Tutorial has reached maximum capacity
|
||||
ExamOccurrenceNoCapacity: Occurrence/Room has reached maximum capacity
|
||||
CourseNotEmpty: There are currently no participants enrolled for this course.
|
||||
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.
|
||||
CourseRegistration: Enrolment
|
||||
CourseRegisterOpen: Enrolment is allowed
|
||||
CourseRegisterOk: Successfully enrolled for course
|
||||
@ -158,6 +164,8 @@ CourseSchoolShort: Department
|
||||
CourseSchoolMultipleTip: You may select from among multiple departments. Please ensure that you select the appropriate department for your course.
|
||||
CourseSecretTip: Enrollment for this course will require the password, if set
|
||||
CourseSecretFormat: Arbitrary string
|
||||
CourseVisibleFromTip: The course will be visible to others from this date onward. When left empty the course will never be visible to other users. This does not affect lecturers, assistants, tutors, correctors, enrolled participants and applicants of/to this course. If the course participates in a central allocation, the course visibility will be forced during the application phase.
|
||||
CourseVisibleToTip: Other users will be able to see the course from "Visible From" up to this date. When left empty visible courses will remain visible indefinitely.
|
||||
CourseRegisterFromTip: When left empty students will not be able to enrol themselves
|
||||
CourseRegisterToTip: May be left empty to allow enrolment indefinitely
|
||||
CourseDeregisterUntilTip: Participants may deregister from immediately after registration starts up to this time. May be left empty to allow deregistration indefinitely.
|
||||
@ -262,13 +270,15 @@ CourseLecturerEmail: Email
|
||||
CourseLecturer: Lecturer
|
||||
CourseAssistant: Assistant
|
||||
CourseLecturerAlreadyAdded: This user is already configured as a course administrator
|
||||
CourseRegistrationEndMustBeAfterStart: The end of the registration period must be before its start
|
||||
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
|
||||
CourseUserMustBeLecturer: The current user needs to be a course administrator
|
||||
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
|
||||
CourseAllocationCapacityMayNotBeChanged: The capacity of a course that participates in a central allocation must not be altered
|
||||
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).
|
||||
|
||||
CourseLecturerRightsIdentical: All sorts of course administrators have the same permissions.
|
||||
|
||||
@ -466,7 +476,8 @@ 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 does not currently allow enrollment.
|
||||
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.
|
||||
@ -1440,6 +1451,7 @@ AuthTagTutorControl: Tutors have control over their tutorial
|
||||
AuthTagTime: Time restrictions are fulfilled
|
||||
AuthTagStaffTime: Time restrictions wrt. staff are fulfilled
|
||||
AuthTagAllocationTime: Time restrictions due to a central allocation are fulfilled
|
||||
AuthTagCourseTime: Time restrictions wrt. course visibility are fulfilled
|
||||
AuthTagCourseRegistered: User is enrolled in course
|
||||
AuthTagAllocationRegistered: User participates in central allocation
|
||||
AuthTagTutorialRegistered: User is tutorial participant
|
||||
@ -2367,6 +2379,7 @@ CourseDeregisterNoShow: Record “no show” when deregistering
|
||||
CourseDeregisterNoShowTip: Should “no show” be recorded as the exam achievement for all exams associated with this course automatically whenever a course participant deregisters themselves? This would be done once upon deregistration (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.
|
||||
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!
|
||||
|
||||
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:
|
||||
|
||||
@ -12,6 +12,8 @@ Course -- Information about a single course; contained info is always visible
|
||||
school SchoolId
|
||||
capacity Int Maybe -- number of allowed enrolements, if restricted
|
||||
-- canRegisterNow = maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo
|
||||
visibleFrom UTCTime Maybe default=now() -- course may be visible from a given day onwards or always hidden
|
||||
visibleTo UTCTime Maybe -- course may be hidden from a given date onwards
|
||||
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
|
||||
|
||||
3
package-lock.json
generated
3
package-lock.json
generated
@ -10943,8 +10943,7 @@
|
||||
"lodash.debounce": {
|
||||
"version": "4.0.8",
|
||||
"resolved": "https://registry.npmjs.org/lodash.debounce/-/lodash.debounce-4.0.8.tgz",
|
||||
"integrity": "sha1-gteb/zCmfEAF/9XiUVMArZyk168=",
|
||||
"dev": true
|
||||
"integrity": "sha1-gteb/zCmfEAF/9XiUVMArZyk168="
|
||||
},
|
||||
"lodash.defaults": {
|
||||
"version": "4.2.0",
|
||||
|
||||
28
routes
28
routes
@ -125,10 +125,10 @@
|
||||
/course/ CourseListR GET !free
|
||||
!/course/new CourseNewR GET POST !lecturer
|
||||
/course/#TermId/#SchoolId/#CourseShorthand CourseR !lecturer:
|
||||
/ CShowR GET !free
|
||||
/ CShowR GET !tutor !corrector !exam-corrector !course-registered !course-time !evaluation !exam-office !allocation-admin
|
||||
/favourite CFavouriteR POST
|
||||
/register CRegisterR GET POST !timeANDcapacityANDallocation-timeAND¬course-registered !timeANDallocation-timeAND¬exam-resultANDcourse-registered !lecturerANDallocation-time
|
||||
/register-template CRegisterTemplateR GET !free
|
||||
/register CRegisterR GET POST !timeANDcapacityANDallocation-timeAND¬course-registeredANDcourse-time !timeANDallocation-timeAND¬exam-resultANDcourse-registered !lecturerANDallocation-time
|
||||
/register-template CRegisterTemplateR GET !course-time
|
||||
/edit CEditR GET POST
|
||||
/lecturer-invite CLecInviteR GET POST
|
||||
/delete CDeleteR GET POST !lecturerANDemptyANDallocation-time
|
||||
@ -142,18 +142,18 @@
|
||||
/exam-office CExamOfficeR GET POST !course-registered
|
||||
/subs CCorrectionsR GET POST
|
||||
/subs/assigned CAssignR GET POST
|
||||
/sheet SheetListR GET !course-registered !materials !corrector !tutor
|
||||
/sheet SheetListR GET !course-registered !materialsANDcourse-time !corrector !tutor
|
||||
/sheet/new SheetNewR GET POST
|
||||
/sheet/current SheetCurrentR GET !course-registered !materials !corrector !tutor
|
||||
/sheet/current SheetCurrentR GET !course-registered !materialsANDcourse-time !corrector !tutor
|
||||
/sheet/unassigned SheetOldUnassignedR GET
|
||||
/sheet/#SheetName SheetR:
|
||||
/show SShowR GET !timeANDcourse-registered !timeANDmaterials !corrector !timeANDtutor
|
||||
/show/download SArchiveR GET !timeANDcourse-registeredANDexam-registered !timeANDmaterialsANDexam-registered !corrector !timeANDtutor
|
||||
/show SShowR GET !timeANDcourse-registered !timeANDmaterialsANDcourse-time !corrector !timeANDtutor
|
||||
/show/download SArchiveR GET !timeANDcourse-registeredANDexam-registered !timeANDmaterialsANDexam-registeredANDcourse-time !corrector !timeANDtutor
|
||||
/edit SEditR GET POST
|
||||
/delete SDelR GET POST
|
||||
/subs SSubsR GET POST -- for lecturer only
|
||||
!/subs/new SubmissionNewR GET POST !timeANDcourse-registeredANDuser-submissionsANDsubmission-groupANDexam-registered
|
||||
!/subs/own SubmissionOwnR GET !free -- just redirect
|
||||
!/subs/own SubmissionOwnR GET !free
|
||||
!/subs/assign SAssignR GET POST !lecturerANDtime
|
||||
/subs/#CryptoFileNameSubmission SubmissionR:
|
||||
/ SubShowR GET POST !ownerANDtimeANDuser-submissionsANDsubmission-groupANDexam-registered !ownerANDread !correctorANDread
|
||||
@ -168,14 +168,14 @@
|
||||
/corrector-invite/ SCorrInviteR GET POST
|
||||
!/#SheetFileType SZipR GET !timeANDcourse-registeredANDexam-registered !timeANDmaterialsANDexam-registered !corrector !timeANDtutor
|
||||
!/#SheetFileType/*FilePath SFileR GET !timeANDcourse-registeredANDexam-registered !timeANDmaterialsANDexam-registered !corrector !timeANDtutor
|
||||
/file MaterialListR GET !course-registered !materials !corrector !tutor
|
||||
/file MaterialListR GET !course-registered !materialsANDcourse-time !corrector !tutor
|
||||
/file/new MaterialNewR GET POST
|
||||
/file/#MaterialName MaterialR:
|
||||
/edit MEditR GET POST
|
||||
/delete MDelR GET POST
|
||||
/show MShowR GET !timeANDcourse-registered !timeANDmaterials !corrector !tutor
|
||||
!/download MArchiveR GET !timeANDcourse-registered !timeANDmaterials !corrector !tutor
|
||||
!/download/*FilePath MFileR GET !timeANDcourse-registered !timeANDmaterials !corrector !tutor
|
||||
/show MShowR GET !timeANDcourse-registered !timeANDmaterialsANDcourse-time !corrector !tutor
|
||||
!/download MArchiveR GET !timeANDcourse-registered !timeANDmaterialsANDcourse-time !corrector !tutor
|
||||
!/download/*FilePath MFileR GET !timeANDcourse-registered !timeANDmaterialsANDcourse-time !corrector !tutor
|
||||
/tuts CTutorialListR GET !tutor -- THIS route is used to check for overall course tutor access!
|
||||
/tuts/new CTutorialNewR GET POST
|
||||
/tuts/#TutorialName TutorialR:
|
||||
@ -185,10 +185,10 @@
|
||||
/register TRegisterR POST !timeANDcapacityANDcourse-registeredANDregister-group !timeANDtutorial-registered
|
||||
/communication TCommR GET POST !tutor
|
||||
/tutor-invite TInviteR GET POST !tutorANDtutor-control
|
||||
/exams CExamListR GET !free
|
||||
/exams CExamListR GET !tutor !corrector !exam-corrector !course-registered !course-time !exam-office
|
||||
/exams/new CExamNewR GET POST
|
||||
/exams/#ExamName ExamR:
|
||||
/show EShowR GET !time !exam-office
|
||||
/show EShowR GET !timeANDtutor !timeANDcorrector !timeANDexam-corrector !timeANDcourse-registered !timeANDcourse-time !exam-office
|
||||
/edit EEditR GET POST
|
||||
/corrector-invite ECInviteR GET POST
|
||||
/users EUsersR GET POST
|
||||
|
||||
@ -75,6 +75,7 @@ import Handler.Utils.ExamOffice.Course
|
||||
import Handler.Utils.Profile
|
||||
import Handler.Utils.Routes
|
||||
import Handler.Utils.Memcached
|
||||
import Utils.Course (courseIsVisible)
|
||||
import Utils.Form
|
||||
import Utils.Sheet
|
||||
import Utils.SystemMessage
|
||||
@ -532,6 +533,11 @@ tagAccessPredicate AuthExamOffice = APDB $ \mAuthId route _ -> case route of
|
||||
E.where_ $ examOfficeExternalExamResultAuth (E.val authId) eexamResult
|
||||
guardMExceptT hasUsers $ unauthorizedI MsgUnauthorizedExternalExamExamOffice
|
||||
return Authorized
|
||||
CourseR _ ssh _ _ -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isExamOffice <- lift . existsBy $ UniqueUserFunction authId ssh SchoolExamOffice
|
||||
guardMExceptT isExamOffice $ unauthorizedI MsgUnauthorizedExamExamOffice
|
||||
return Authorized
|
||||
_other -> $cachedHereBinary mAuthId . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isExamOffice <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolExamOffice]
|
||||
@ -543,6 +549,11 @@ tagAccessPredicate AuthEvaluation = APDB $ \mAuthId route _ -> case route of
|
||||
isEvaluation <- lift . existsBy $ UniqueUserFunction authId ssh SchoolEvaluation
|
||||
guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedEvaluation
|
||||
return Authorized
|
||||
CourseR _ ssh _ _ -> $cachedHereBinary(mAuthId, ssh) . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isEvaluation <- lift . existsBy $ UniqueUserFunction authId ssh SchoolEvaluation
|
||||
guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedEvaluation
|
||||
return Authorized
|
||||
_other -> $cachedHereBinary mAuthId . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isEvaluation <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolEvaluation]
|
||||
@ -554,6 +565,11 @@ tagAccessPredicate AuthAllocationAdmin = APDB $ \mAuthId route _ -> case route o
|
||||
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]
|
||||
@ -654,12 +670,23 @@ tagAccessPredicate AuthExamCorrector = APDB $ \mAuthId route _ -> case route of
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isCorrector <- lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examCorrector) -> do
|
||||
E.on $ examCorrector E.^. ExamCorrectorExam E.==. exam E.^. ExamId
|
||||
E.&&. examCorrector E.^. ExamCorrectorUser E.==. E.val authId
|
||||
E.on $ exam E.^. ExamCourse E.==. course E.^. CourseId
|
||||
E.where_ $ course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
E.&&. exam E.^. ExamName E.==. E.val examn
|
||||
E.where_ $ examCorrector E.^. ExamCorrectorUser E.==. E.val authId
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
E.&&. exam E.^. ExamName E.==. E.val examn
|
||||
guardMExceptT isCorrector $ unauthorizedI MsgUnauthorizedExamCorrector
|
||||
return Authorized
|
||||
CourseR tid ssh csh _ -> $cachedHereBinary (tid, ssh, csh) . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isCorrector <- lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examCorrector) -> do
|
||||
E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
|
||||
E.on $ exam E.^. ExamId E.==. examCorrector E.^. ExamCorrectorExam
|
||||
E.where_ $ examCorrector E.^. ExamCorrectorUser E.==. E.val authId
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
guardMExceptT isCorrector $ unauthorizedI MsgUnauthorizedExamCorrector
|
||||
return Authorized
|
||||
r -> $unsupportedAuthPredicate AuthExamCorrector r
|
||||
@ -828,7 +855,7 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
|
||||
, maybe True (now <=) courseRegisterTo -> return Authorized
|
||||
(Just (Entity cid Course{courseDeregisterUntil}))
|
||||
| registered
|
||||
-> maybeT (unauthorizedI MsgUnauthorizedCourseTime) $ do
|
||||
-> maybeT (unauthorizedI MsgUnauthorizedCourseRegistrationTime) $ do
|
||||
guard $ maybe True (now <=) courseDeregisterUntil
|
||||
forM_ mAuthId $ \uid -> do
|
||||
exams <- lift . E.select . E.from $ \exam -> do
|
||||
@ -849,8 +876,8 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
|
||||
forM_ tutorials $ \(E.Value deregUntil) ->
|
||||
guard $ NTop (Just now) <= NTop deregUntil
|
||||
return Authorized
|
||||
_other -> unauthorizedI MsgUnauthorizedCourseTime
|
||||
|
||||
_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
|
||||
@ -971,6 +998,17 @@ tagAccessPredicate AuthAllocationTime = APDB $ \mAuthId route _ -> case route of
|
||||
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
|
||||
courseVisible <- $cachedHereBinary (tid, ssh, csh) . lift . E.selectExists . E.from $ \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
|
||||
E.&&. courseIsVisible now course Nothing
|
||||
guardMExceptT courseVisible (unauthorizedI MsgUnauthorizedCourseTime)
|
||||
return Authorized
|
||||
r -> $unsupportedAuthPredicate AuthCourseTime r
|
||||
tagAccessPredicate AuthCourseRegistered = APDB $ \mAuthId route _ -> case route of
|
||||
CourseR tid ssh csh _ -> exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
@ -1460,7 +1498,7 @@ authTagSpecificity = comparing $ NTop . flip findIndex eqClasses . elem
|
||||
[ [ AuthFree, AuthDeprecated, AuthDevelopment ] -- Route wide
|
||||
, [ AuthRead, AuthWrite, AuthToken ] -- Request wide
|
||||
, [ AuthAdmin ] -- Site wide
|
||||
, [ AuthLecturer, AuthCourseRegistered, AuthParticipant, AuthTime, AuthMaterials, AuthUserSubmissions, AuthCorrectorSubmissions, AuthCapacity, AuthEmpty ] ++ [ AuthSelf, AuthNoEscalation ] ++ [ AuthAuthentication ] -- Course/User/SystemMessage wide
|
||||
, [ AuthLecturer, AuthCourseRegistered, AuthParticipant, AuthCourseTime, AuthTime, AuthMaterials, AuthUserSubmissions, AuthCorrectorSubmissions, AuthCapacity, AuthEmpty ] ++ [ AuthSelf, AuthNoEscalation ] ++ [ AuthAuthentication ] -- Course/User/SystemMessage wide
|
||||
, [ AuthCorrector ] ++ [ AuthTutor ] ++ [ AuthTutorialRegistered, AuthRegisterGroup ] -- Tutorial/Material/Sheet wide
|
||||
, [ AuthOwner, AuthRated ] -- Submission wide
|
||||
]
|
||||
@ -1961,12 +1999,14 @@ siteLayout' headingOverride widget = do
|
||||
-- isParent r = r == (fst parents)
|
||||
|
||||
isAuth <- isJust <$> maybeAuthId
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
|
||||
-- Lookup Favourites & Theme if possible
|
||||
(favourites', maxFavouriteTerms, currentTheme) <- do
|
||||
muid <- maybeAuthPair
|
||||
|
||||
favCourses <- runDB . E.select . E.from $ \(course `E.LeftOuterJoin` courseFavourite) -> do
|
||||
favCourses'' <- runDB . 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)
|
||||
|
||||
@ -1997,6 +2037,7 @@ siteLayout' headingOverride 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 Nothing
|
||||
|
||||
reason = E.case_
|
||||
[ E.when_ isCurrent E.then_ . E.just $ E.val FavouriteCurrent
|
||||
@ -2005,7 +2046,14 @@ siteLayout' headingOverride widget = do
|
||||
|
||||
E.where_ $ ((isFavourite E.||. isAssociated) E.&&. notBlacklist) E.||. isCurrent
|
||||
|
||||
return (course, reason)
|
||||
return (course, reason, courseVisible)
|
||||
|
||||
favCourses' <- forM favCourses'' $ \(course@(Entity _ Course{..}), reason, E.Value courseVisible) -> do
|
||||
mayView <- hasReadAccessTo $ CourseR courseTerm courseSchool courseShorthand CShowR
|
||||
mayEdit <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
|
||||
return (course, reason, courseVisible, mayView, mayEdit)
|
||||
|
||||
let favCourses = favCourses' & filter (\(_, _, _, mayView, _) -> mayView)
|
||||
|
||||
return ( favCourses
|
||||
, maybe userDefaultMaxFavouriteTerms userMaxFavouriteTerms $ view _2 <$> muid
|
||||
@ -2013,9 +2061,9 @@ siteLayout' headingOverride widget = do
|
||||
)
|
||||
|
||||
let favouriteTerms :: [TermIdentifier]
|
||||
favouriteTerms = take maxFavouriteTerms . Set.toDescList $ foldMap (\(Entity _ Course{..}, _) -> Set.singleton $ unTermKey courseTerm) favourites'
|
||||
|
||||
favourites <- fmap catMaybes . forM favourites' $ \(Entity cId c@Course{..}, E.Value mFavourite)
|
||||
favouriteTerms = take maxFavouriteTerms . Set.toDescList $ foldMap (\(Entity _ Course{..}, _, _, _, _) -> Set.singleton $ unTermKey courseTerm) favourites'
|
||||
|
||||
favourites <- fmap catMaybes . forM favourites' $ \(Entity cId c@Course{..}, E.Value mFavourite, courseVisible, mayView, mayEdit)
|
||||
-> let courseRoute = CourseR courseTerm courseSchool courseShorthand CShowR
|
||||
favouriteReason = fromMaybe FavouriteCurrent mFavourite
|
||||
in runMaybeT . guardOnM (unTermKey courseTerm `elem` favouriteTerms) . lift $ do
|
||||
@ -2037,7 +2085,7 @@ siteLayout' headingOverride widget = do
|
||||
$logDebugS "FavouriteQuickActions" $ tshow cK <> " Done."
|
||||
return items
|
||||
$logDebugS "FavouriteQuickActions" $ tshow cK <> " returning " <> tshow (is _Just items)
|
||||
return (c, courseRoute, items, favouriteReason)
|
||||
return (c, courseRoute, items, favouriteReason, courseVisible, mayView, mayEdit)
|
||||
|
||||
nav'' <- mconcat <$> sequence
|
||||
[ defaultLinks
|
||||
@ -2069,10 +2117,10 @@ siteLayout' headingOverride widget = do
|
||||
navItems = map (view _2) favourites ++ toListOf (folded . typesUsing @NavChildren @NavLink . to urlRoute) nav
|
||||
highR = find (`elem` navItems) . uncurry (++) $ partition (`elem` map (view _2) favourites) crumbs
|
||||
highlightNav = (||) <$> navForceActive <*> highlight
|
||||
favouriteTermReason :: TermIdentifier -> FavouriteReason -> [(Course, Route UniWorX, Maybe [(Text, Text)], FavouriteReason)]
|
||||
favouriteTermReason :: TermIdentifier -> FavouriteReason -> [(Course, Route UniWorX, Maybe [(Text, Text)], FavouriteReason, Bool, Bool, Bool)]
|
||||
favouriteTermReason tid favReason' = favourites
|
||||
& filter (\(Course{..}, _, _, favReason) -> unTermKey courseTerm == tid && favReason == favReason')
|
||||
& sortOn (\(Course{..}, _, _, _) -> courseName)
|
||||
& filter (\(Course{..}, _, _, favReason, _, _, _) -> unTermKey courseTerm == tid && favReason == favReason')
|
||||
& sortOn (\(Course{..}, _, _, _, _, _, _) -> courseName)
|
||||
|
||||
-- We break up the default layout into two components:
|
||||
-- default-layout is the contents of the body tag, and
|
||||
@ -2171,7 +2219,8 @@ siteLayout' headingOverride widget = do
|
||||
isNavHeaderSecondary = has $ _1 . _navHeaderRole . only NavHeaderSecondary
|
||||
asidenav :: Widget
|
||||
asidenav = $(widgetFile "widgets/asidenav/asidenav")
|
||||
where logo = preEscapedToMarkup $ decodeUtf8 $(embedFile "assets/lmu/logo.svg")
|
||||
where
|
||||
logo = preEscapedToMarkup $ decodeUtf8 $(embedFile "assets/lmu/logo.svg")
|
||||
footer :: Widget
|
||||
footer = $(widgetFile "widgets/footer/footer")
|
||||
where isNavFooter = has $ _1 . _NavFooter
|
||||
|
||||
@ -6,6 +6,8 @@ module Handler.Allocation.List
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Course (mayViewCourse)
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
import Handler.Utils.Table.Columns
|
||||
@ -23,18 +25,23 @@ queryAllocation = id
|
||||
|
||||
|
||||
countCourses :: (Num n, PersistField n)
|
||||
=> (E.SqlExpr (Entity AllocationCourse) -> E.SqlExpr (E.Value Bool))
|
||||
=> Maybe UserId -> AuthTagActive -> UTCTime
|
||||
-> (E.SqlExpr (Entity AllocationCourse) -> E.SqlExpr (E.Value Bool))
|
||||
-> E.SqlExpr (Entity Allocation)
|
||||
-> E.SqlExpr (E.Value n)
|
||||
countCourses addWhere allocation = E.subSelectCount . E.from $ \allocationCourse ->
|
||||
countCourses muid ata now addWhere allocation = E.subSelectCount . E.from $ \allocationCourse ->
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseAllocation E.==. allocation E.^. AllocationId
|
||||
E.&&. addWhere allocationCourse
|
||||
|
||||
queryAvailable :: Getter AllocationTableExpr (E.SqlExpr (E.Value Natural))
|
||||
queryAvailable = queryAllocation . to (countCourses $ const E.true)
|
||||
|
||||
queryApplied :: UserId -> Getter AllocationTableExpr (E.SqlExpr (E.Value Natural))
|
||||
queryApplied uid = queryAllocation . to (\allocation -> countCourses (addWhere allocation) allocation)
|
||||
E.&&. E.exists (E.from $ \course -> E.where_ $
|
||||
course E.^. CourseId E.==. allocationCourse E.^. AllocationCourseCourse
|
||||
E.&&. mayViewCourse muid ata now course (Just (allocation E.^. AllocationId))
|
||||
) E.&&. addWhere allocationCourse
|
||||
|
||||
queryAvailable :: Maybe UserId -> AuthTagActive -> UTCTime
|
||||
-> Getter AllocationTableExpr (E.SqlExpr (E.Value Natural))
|
||||
queryAvailable muid ata now = queryAllocation . to (countCourses muid ata now $ const E.true)
|
||||
|
||||
queryApplied :: AuthTagActive -> UTCTime -> UserId -> Getter AllocationTableExpr (E.SqlExpr (E.Value Natural))
|
||||
queryApplied ata now uid = queryAllocation . to (\allocation -> countCourses (Just uid) ata now (addWhere allocation) allocation)
|
||||
where
|
||||
addWhere allocation allocationCourse
|
||||
= E.exists . E.from $ \courseApplication ->
|
||||
@ -61,13 +68,14 @@ allocationLink Allocation{..} = SomeRoute $ AllocationR allocationTerm allocatio
|
||||
getAllocationListR :: Handler Html
|
||||
getAllocationListR = do
|
||||
muid <- maybeAuthId
|
||||
ata <- getSessionActiveAuthTags
|
||||
now <- liftIO getCurrentTime
|
||||
let
|
||||
dbtSQLQuery :: AllocationTableExpr -> E.SqlQuery _
|
||||
dbtSQLQuery = runReaderT $ (,,)
|
||||
<$> view queryAllocation
|
||||
<*> view queryAvailable
|
||||
<*> view (maybe (to . const $ E.val 0) queryApplied muid)
|
||||
<*> view (queryAvailable muid ata now)
|
||||
<*> view (maybe (to . const $ E.val 0) (queryApplied ata now) muid)
|
||||
|
||||
dbtProj :: DBRow _ -> DB AllocationTableData
|
||||
dbtProj = return . over (_dbrOutput . _2) E.unValue . over (_dbrOutput . _3) E.unValue
|
||||
@ -91,10 +99,10 @@ getAllocationListR = do
|
||||
[ sortTerm $ queryAllocation . to (E.^. AllocationTerm)
|
||||
, sortSchoolShort $ queryAllocation . to (E.^. AllocationSchool)
|
||||
, sortAllocationName $ queryAllocation . to (E.^. AllocationName)
|
||||
, singletonMap "available" . SortColumn $ view queryAvailable
|
||||
, singletonMap "available" . SortColumn $ view (queryAvailable muid ata now)
|
||||
, if
|
||||
| Just uid <- muid
|
||||
-> singletonMap "applied" . SortColumn . view $ queryApplied uid
|
||||
-> singletonMap "applied" . SortColumn . view $ queryApplied ata now uid
|
||||
| otherwise
|
||||
-> mempty
|
||||
]
|
||||
|
||||
@ -3,18 +3,23 @@ module Handler.Allocation.Show
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Course
|
||||
|
||||
import Handler.Utils
|
||||
|
||||
import Handler.Allocation.Register
|
||||
import Handler.Allocation.Application
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
|
||||
getAShowR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
|
||||
getAShowR tid ssh ash = do
|
||||
muid <- maybeAuthId
|
||||
now <- liftIO getCurrentTime
|
||||
ata <- getSessionActiveAuthTags
|
||||
|
||||
let
|
||||
resultCourse :: Simple Field1 a (Entity Course) => Lens' a (Entity Course)
|
||||
@ -25,6 +30,8 @@ getAShowR tid ssh ash = do
|
||||
resultHasTemplate = _3 . _Value
|
||||
resultIsRegistered :: Simple Field4 a (E.Value Bool) => Lens' a Bool
|
||||
resultIsRegistered = _4 . _Value
|
||||
resultCourseVisible :: Simple Field5 a (E.Value Bool) => Lens' a Bool
|
||||
resultCourseVisible = _5 . _Value
|
||||
|
||||
(Entity aId Allocation{..}, School{..}, isAnyLecturer, courses, registration) <- runDB $ do
|
||||
alloc@(Entity aId Allocation{allocationSchool}) <- getBy404 $ TermSchoolAllocationShort tid ssh ash
|
||||
@ -32,17 +39,20 @@ getAShowR tid ssh ash = do
|
||||
|
||||
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.&&. 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.&&. 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 (Just $ E.val aId)
|
||||
)
|
||||
E.orderBy [E.asc $ course E.^. CourseName]
|
||||
let hasTemplate = E.exists . E.from $ \courseAppInstructionFile ->
|
||||
E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. course E.^. CourseId
|
||||
return (course, courseApplication, hasTemplate, E.not_ . E.isNothing $ registration E.?. CourseParticipantId)
|
||||
return (course, courseApplication, hasTemplate, E.not_ . E.isNothing $ registration E.?. CourseParticipantId, courseIsVisible now course (Just (E.val aId)))
|
||||
|
||||
registration <- fmap join . for muid $ getBy . UniqueAllocationUser aId
|
||||
|
||||
@ -77,8 +87,10 @@ getAShowR tid ssh ash = do
|
||||
hasApplicationTemplate = cEntry ^. resultHasTemplate
|
||||
mApp = cEntry ^? resultCourseApplication
|
||||
isRegistered = cEntry ^. resultIsRegistered
|
||||
courseVisible = cEntry ^. resultCourseVisible
|
||||
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 uid $ ApplicationFormMode True mayApply isLecturer
|
||||
tRoute <- case mApp of
|
||||
|
||||
@ -36,6 +36,8 @@ data CourseForm = CourseForm
|
||||
, cfTerm :: TermId
|
||||
, cfDesc :: Maybe Html
|
||||
, cfLink :: Maybe Text
|
||||
, cfVisFrom :: Maybe UTCTime
|
||||
, cfVisTo :: Maybe UTCTime
|
||||
, cfMatFree :: Bool
|
||||
, cfAllocation :: Maybe AllocationCourseForm
|
||||
, cfAppRequired :: Bool
|
||||
@ -77,6 +79,8 @@ courseToForm cEnt@(Entity cid Course{..}) lecs lecInvites alloc = CourseForm
|
||||
, cfAppText = courseApplicationsText
|
||||
, cfAppFiles = courseApplicationsFiles
|
||||
, cfAppRatingsVisible = courseApplicationsRatingsVisible
|
||||
, cfVisFrom = courseVisibleFrom
|
||||
, cfVisTo = courseVisibleTo
|
||||
, cfRegFrom = courseRegisterFrom
|
||||
, cfRegTo = courseRegisterTo
|
||||
, cfDeRegUntil = courseDeregisterUntil
|
||||
@ -102,6 +106,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
|
||||
-- TODO: Refactor to avoid the four repeated calls to liftHandler and three runDBs
|
||||
-- let editCid = cfCourseId =<< template -- possible start for refactoring
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
|
||||
uid <- liftHandler requireAuthId
|
||||
@ -190,13 +195,15 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
|
||||
unliftEither (Right (lid , lType )) = (Right lid , Just lType)
|
||||
unliftEither (Left (lEmail, mLType)) = (Left lEmail, mLType )
|
||||
|
||||
(newRegFrom,newRegTo,newDeRegUntil) <- case template of
|
||||
(Just cform) | (Just _cid) <- cfCourseId cform -> return (Nothing,Nothing,Nothing)
|
||||
(newVisFrom,newRegFrom,newRegTo,newDeRegUntil) <- case template of
|
||||
(Just cform) | (Just _cid) <- cfCourseId cform -> return (Nothing,Nothing,Nothing,Nothing)
|
||||
_allIOtherCases -> do
|
||||
mbLastTerm <- liftHandler $ runDB $ selectFirst [TermActive ==. True] [Desc TermName]
|
||||
return ( Just . toMidnight . termStart . entityVal <$> mbLastTerm
|
||||
return ( Just $ Just now
|
||||
, Just . toMidnight . termStart . entityVal <$> mbLastTerm
|
||||
, Just . beforeMidnight . termEnd . entityVal <$> mbLastTerm
|
||||
, Just . beforeMidnight . termEnd . entityVal <$> mbLastTerm )
|
||||
, Just . beforeMidnight . termEnd . entityVal <$> mbLastTerm
|
||||
)
|
||||
|
||||
let
|
||||
allocationForm :: AForm Handler (Maybe AllocationCourseForm)
|
||||
@ -214,7 +221,6 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
|
||||
E.||. allocation E.^. AllocationSchool `E.in_` E.valList adminSchools
|
||||
return (allocation, alreadyParticipates)
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
let
|
||||
allocationEnabled :: Entity Allocation -> Bool
|
||||
allocationEnabled (Entity _ Allocation{..})
|
||||
@ -273,7 +279,11 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
|
||||
(cfDesc <$> template)
|
||||
<*> aopt (urlField & cfStrip) (fslpI MsgCourseHomepageExternal (mr MsgCourseHomepageExternalPlaceholder))
|
||||
(cfLink <$> template)
|
||||
<*> apopt checkBoxField (fslI MsgMaterialFree) (cfMatFree <$> template)
|
||||
<*> aopt utcTimeField (fslpI MsgCourseVisibleFrom (mr MsgDate)
|
||||
& setTooltip MsgCourseVisibleFromTip) (deepAlt (cfVisFrom <$> template) newVisFrom)
|
||||
<*> aopt utcTimeField (fslpI MsgCourseVisibleTo (mr MsgDate)
|
||||
& setTooltip MsgCourseVisibleToTip) (cfVisTo <$> template)
|
||||
<*> apopt checkBoxField (fslI MsgMaterialFree) (cfMatFree <$> template)
|
||||
<* aformSection MsgCourseFormSectionRegistration
|
||||
<*> allocationForm
|
||||
<*> apopt checkBoxField (fslI MsgCourseApplicationRequired & setTooltip MsgCourseApplicationRequiredTip) (cfAppRequired <$> template)
|
||||
@ -319,6 +329,8 @@ validateCourse = do
|
||||
| otherwise
|
||||
-> return Nothing
|
||||
|
||||
guardValidation MsgCourseVisibilityEndMustBeAfterStart
|
||||
$ NTop cfVisFrom <= NTop cfVisTo
|
||||
guardValidation MsgCourseRegistrationEndMustBeAfterStart
|
||||
$ NTop cfRegFrom <= NTop cfRegTo
|
||||
guardValidation MsgCourseDeregistrationEndMustBeAfterStart
|
||||
@ -335,7 +347,9 @@ validateCourse = do
|
||||
|
||||
warnValidation MsgCourseShorthandTooLong
|
||||
$ length (CI.original cfShort) <= 10
|
||||
|
||||
warnValidation MsgCourseNotAlwaysVisibleDuringRegistration
|
||||
$ NTop cfVisFrom <= NTop cfRegFrom && NTop cfRegTo <= NTop cfVisTo
|
||||
|
||||
|
||||
getCourseNewR :: Handler Html -- call via toTextUrl
|
||||
getCourseNewR = do
|
||||
@ -456,6 +470,8 @@ courseEditHandler miButtonAction mbCourseForm = do
|
||||
, courseApplicationsText = cfAppText
|
||||
, courseApplicationsFiles = cfAppFiles
|
||||
, courseApplicationsRatingsVisible = cfAppRatingsVisible
|
||||
, courseVisibleFrom = cfVisFrom
|
||||
, courseVisibleTo = cfVisTo
|
||||
, courseRegisterFrom = cfRegFrom
|
||||
, courseRegisterTo = cfRegTo
|
||||
, courseDeregisterUntil = cfDeRegUntil
|
||||
@ -504,6 +520,8 @@ courseEditHandler miButtonAction mbCourseForm = do
|
||||
, courseApplicationsText = cfAppText
|
||||
, courseApplicationsFiles = cfAppFiles
|
||||
, courseApplicationsRatingsVisible = cfAppRatingsVisible
|
||||
, courseVisibleFrom = cfVisFrom
|
||||
, courseVisibleTo = cfVisTo
|
||||
, courseRegisterFrom = cfRegFrom
|
||||
, courseRegisterTo = cfRegTo
|
||||
, courseDeregisterUntil = cfDeRegUntil
|
||||
|
||||
@ -10,6 +10,7 @@ import Import
|
||||
|
||||
import Data.Maybe (fromJust)
|
||||
|
||||
import Utils.Course
|
||||
import Utils.Form
|
||||
-- import Utils.DB
|
||||
import Handler.Utils hiding (colSchoolShort)
|
||||
@ -22,75 +23,75 @@ import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
|
||||
-- NOTE: Outdated way to use dbTable; see ProfileDataR Handler for a more recent method.
|
||||
type CourseTableData = DBRow (Entity Course, Int, Bool, Entity School, [Entity User], Maybe (Entity Allocation))
|
||||
type CourseTableData = DBRow (Entity Course, Int, Bool, Entity School, [Entity User], Maybe (Entity Allocation), Bool)
|
||||
|
||||
colCourse :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
|
||||
colCourse = sortable (Just "course") (i18nCell MsgCourse)
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _) } ->
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _, _) } ->
|
||||
anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR)
|
||||
[whamlet|_{courseName}|]
|
||||
|
||||
colDescription :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
|
||||
colDescription = sortable Nothing mempty
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _) } ->
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _, _) } ->
|
||||
case courseDescription of
|
||||
Nothing -> mempty
|
||||
(Just descr) -> cell $ modal (toWidget $ hasComment True) (Right $ toWidget descr)
|
||||
|
||||
colCShort :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
|
||||
colCShort = sortable (Just "cshort") (i18nCell MsgCourseShort)
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _) } ->
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _, _) } ->
|
||||
anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|_{courseShorthand}|]
|
||||
|
||||
colTerm :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
|
||||
colTerm = sortable (Just "term") (i18nCell MsgTerm)
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _) } ->
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _, _) } ->
|
||||
anchorCell (TermCourseListR courseTerm) [whamlet|#{courseTerm}|]
|
||||
|
||||
colSchoolShort :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
|
||||
colSchoolShort = sortable (Just "schoolshort") (i18nCell MsgCourseSchoolShort)
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, Entity _ School{..}, _, _) } ->
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, Entity _ School{..}, _, _, _) } ->
|
||||
anchorCell (TermSchoolCourseListR courseTerm courseSchool) [whamlet|_{schoolShorthand}|]
|
||||
|
||||
colRegistered :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
|
||||
colRegistered = sortable (Just "registered") (i18nCell MsgRegistered)
|
||||
$ \DBRow{ dbrOutput=(_, _, registered, _, _, _) } -> tickmarkCell registered
|
||||
$ \DBRow{ dbrOutput=(_, _, registered, _, _, _, _) } -> tickmarkCell registered
|
||||
|
||||
type CourseTableExpr = E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity School)
|
||||
|
||||
course2Participants :: CourseTableExpr -> E.SqlExpr (E.Value Int)
|
||||
course2Participants (course `E.InnerJoin` _school) = E.subSelectCount . E.from $ \courseParticipant ->
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
||||
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
course2Participants (course `E.InnerJoin` _school) = numCourseParticipants $ course E.^. CourseId
|
||||
|
||||
course2Registered :: Maybe UserId -> CourseTableExpr -> E.SqlExpr (E.Value Bool)
|
||||
course2Registered muid (course `E.InnerJoin` _school) = E.exists . E.from $ \courseParticipant ->
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
||||
E.&&. E.just (courseParticipant E.^. CourseParticipantUser) E.==. E.val muid
|
||||
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
course2Registered :: Maybe UserId -> AuthTagActive -> CourseTableExpr -> E.SqlExpr (E.Value Bool)
|
||||
course2Registered muid ata (course `E.InnerJoin` _school) = isCourseParticipant muid ata $ course E.^. CourseId
|
||||
|
||||
makeCourseTable :: ( IsDBTable m x, ToSortable h, Functor h, DBResult m x ~ ((), Widget) )
|
||||
=> _ -> Colonnade h CourseTableData (DBCell m x) -> PSValidator m x -> DB Widget
|
||||
makeCourseTable whereClause colChoices psValidator = do
|
||||
muid <- lift maybeAuthId
|
||||
now <- liftIO getCurrentTime
|
||||
ata <- getSessionActiveAuthTags
|
||||
let dbtSQLQuery :: CourseTableExpr -> E.SqlQuery _
|
||||
dbtSQLQuery qin@(course `E.InnerJoin` school) = do
|
||||
E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
|
||||
let participants = course2Participants qin
|
||||
let registered = course2Registered muid qin
|
||||
E.where_ $ whereClause (course, participants, registered)
|
||||
let registered = course2Registered muid ata qin
|
||||
let mayView = mayViewCourse muid ata now course Nothing
|
||||
E.where_ $ whereClause (course, participants, registered, mayView)
|
||||
return (course, participants, registered, school)
|
||||
lecturerQuery cid (user `E.InnerJoin` lecturer) = do
|
||||
E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
|
||||
E.where_ $ cid E.==. lecturer E.^. LecturerCourse E.&&. lecturer E.^. LecturerType E.==. E.val CourseLecturer
|
||||
return user
|
||||
isEditorQuery course user = E.where_ $ mayEditCourse' muid ata course
|
||||
E.&&. E.just (user E.^. UserId) E.==. E.val muid
|
||||
dbtProj :: DBRow _ -> DB CourseTableData
|
||||
dbtProj = traverse $ \(course, E.Value participants, E.Value registered, school) -> do
|
||||
lecturerList <- E.select $ E.from $ lecturerQuery $ E.val $ entityKey course
|
||||
courseAlloc <- getBy (UniqueAllocationCourse $ entityKey course)
|
||||
>>= traverse (getJustEntity . allocationCourseAllocation . entityVal)
|
||||
return (course, participants, registered, school, lecturerList, courseAlloc)
|
||||
isEditorList <- E.select $ E.from $ isEditorQuery course
|
||||
return (course, participants, registered, school, lecturerList, courseAlloc, not $ null isEditorList)
|
||||
snd <$> dbTable psValidator DBTable
|
||||
{ dbtSQLQuery
|
||||
, dbtRowKey = \(course `E.InnerJoin` _) -> course E.^. CourseId
|
||||
@ -105,7 +106,7 @@ makeCourseTable whereClause colChoices psValidator = do
|
||||
, ( "register-from", SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseRegisterFrom)
|
||||
, ( "register-to", SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseRegisterTo)
|
||||
, ( "members", SortColumn course2Participants )
|
||||
, ( "registered", SortColumn $ course2Registered muid)
|
||||
, ( "registered", SortColumn $ course2Registered muid ata)
|
||||
]
|
||||
, dbtFilter = Map.fromList -- OverloadedLists does not work with the templates here
|
||||
[ ( "course", FilterColumn $ \(course `E.InnerJoin` _school:: CourseTableExpr) criterias -> if
|
||||
@ -160,7 +161,7 @@ makeCourseTable whereClause colChoices psValidator = do
|
||||
)
|
||||
, ( "registered", FilterColumn $ \tExpr criterion -> case getLast (criterion :: Last Bool) of
|
||||
Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||
Just needle -> course2Registered muid tExpr E.==. E.val needle
|
||||
Just needle -> course2Registered muid ata tExpr E.==. E.val needle
|
||||
)
|
||||
, ( "search", FilterColumn $ \(course `E.InnerJoin` _school :: CourseTableExpr) criterion -> case getLast (criterion :: Last Text) of
|
||||
Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||
@ -179,8 +180,13 @@ makeCourseTable whereClause colChoices psValidator = do
|
||||
]
|
||||
, dbtStyle = def
|
||||
{ dbsFilterLayout = defaultDBSFilterLayout
|
||||
, dbsTemplate = DBSTCourse (_dbrOutput . _1) (_dbrOutput . _5) (_dbrOutput . _3) (_dbrOutput . _4) (_dbrOutput . _6 . _Just)
|
||||
-- ^ course ^ lecturer list ^ isRegistered ^ school ^ allocation
|
||||
, dbsTemplate = DBSTCourse
|
||||
(_dbrOutput . _1) -- course
|
||||
(_dbrOutput . _5) -- lecturer list
|
||||
(_dbrOutput . _3) -- isRegistered
|
||||
(_dbrOutput . _4) -- school
|
||||
(_dbrOutput . _6 . _Just) -- allocation
|
||||
(_dbrOutput . _7) -- mayEditCourse
|
||||
}
|
||||
, dbtParams = def
|
||||
, dbtIdent = "courses" :: Text
|
||||
@ -199,7 +205,7 @@ getCourseListR = do
|
||||
, colCShort
|
||||
, maybe mempty (const colRegistered) muid
|
||||
]
|
||||
whereClause = const $ E.val True
|
||||
whereClause (_, _, _, mayView) = mayView
|
||||
validator = def
|
||||
& defaultSorting [SortDescBy "term",SortAscBy "course"]
|
||||
coursesTable <- runDB $ makeCourseTable whereClause colonnade validator
|
||||
|
||||
@ -10,12 +10,15 @@ import Import
|
||||
|
||||
import Handler.Utils
|
||||
|
||||
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 as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
|
||||
-- Dedicated CourseRegistrationButton
|
||||
@ -47,6 +50,9 @@ courseRegisterForm :: (MonadHandler m, HandlerSite m ~ UniWorX) => Entity Course
|
||||
-- ^ `CourseRegisterForm` for current user
|
||||
courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
|
||||
muid <- maybeAuthId
|
||||
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] []
|
||||
@ -141,10 +147,23 @@ courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
|
||||
| otherwise
|
||||
-> aFormToWForm $ fileUploadForm False (fslI . mkFs) courseApplicationsFiles
|
||||
|
||||
mayViewCourseAfterDeregistration <- liftHandler . runDB $ E.selectExists . E.from $ \course -> 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 Nothing
|
||||
E.||. isCourseLecturer muid ata (course E.^. CourseId)
|
||||
E.||. isCourseTutor muid ata (course E.^. CourseId)
|
||||
E.||. isCourseSheetCorrector muid ata (course E.^. CourseId)
|
||||
E.||. isCourseExamCorrector muid ata (course E.^. CourseId)
|
||||
)
|
||||
|
||||
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
|
||||
|
||||
return $ CourseRegisterForm
|
||||
<$ secretRes
|
||||
@ -246,7 +265,13 @@ postCRegisterR tid ssh csh = do
|
||||
BtnCourseRetractApplication -> runDB $ do
|
||||
deleteApplications uid cid
|
||||
addMessageIconI Info IconApplyFalse MsgCourseRetractApplyOk
|
||||
redirect $ CourseR tid ssh csh CShowR
|
||||
muid <- maybeAuthId
|
||||
ata <- getSessionActiveAuthTags
|
||||
now <- liftIO getCurrentTime
|
||||
courseVisible <- runDB . E.selectExists . E.from $ \c -> E.where_ $
|
||||
c E.^. CourseId E.==. E.val cid
|
||||
E.&&. mayViewCourse muid ata now c Nothing
|
||||
redirect $ bool NewsR (CourseR tid ssh csh CShowR) courseVisible
|
||||
|
||||
deleteApplications :: UserId -> CourseId -> DB ()
|
||||
deleteApplications uid cid = do
|
||||
|
||||
@ -5,6 +5,7 @@ module Handler.Course.Show
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Course
|
||||
import Utils.Form
|
||||
import Handler.Utils
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
@ -26,8 +27,9 @@ import Handler.Exam.List (mkExamTable)
|
||||
getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getCShowR tid ssh csh = do
|
||||
mbAid <- maybeAuthId
|
||||
(cid,course,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication,news,events,submissionGroup) <- runDB . maybeT notFound $ do
|
||||
[(E.Entity cid course, E.Value schoolName, E.Value participants, fmap entityVal -> registration)]
|
||||
now <- liftIO getCurrentTime
|
||||
(cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication,news,events,submissionGroup,hasAllocationRegistrationOpen) <- runDB . maybeT notFound $ do
|
||||
[(E.Entity cid course, E.Value courseVisible, E.Value schoolName, E.Value participants, fmap entityVal -> registration, E.Value hasAllocationRegistrationOpen)]
|
||||
<- lift . E.select . E.from $
|
||||
\((school `E.InnerJoin` course) `E.LeftOuterJoin` participant) -> do
|
||||
E.on $ E.just (course E.^. CourseId) E.==. participant E.?. CourseParticipantCourse
|
||||
@ -42,7 +44,7 @@ getCShowR tid ssh csh = do
|
||||
numParticipants = E.subSelectCount . E.from $ \part ->
|
||||
E.where_ $ part E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
||||
E.&&. part E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
return (course,school E.^. SchoolName, numParticipants, participant)
|
||||
return (course, courseIsVisible now course Nothing, school E.^. SchoolName, numParticipants, participant, courseAllocationRegistrationOpen now (course E.^. CourseId) Nothing)
|
||||
staff <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do
|
||||
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
|
||||
E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
|
||||
@ -86,9 +88,9 @@ getCShowR tid ssh csh = do
|
||||
& over (mapped . _1) E.unValue
|
||||
& over (mapped . _2) E.unValue
|
||||
lastEditText <- formatTime SelFormatDateTime $ maybe id max (guardOn visible =<< courseNewsVisibleFrom) courseNewsLastEdit
|
||||
mayEdit <- hasWriteAccessTo $ CNewsR tid ssh csh cID CNEditR
|
||||
mayEditNews <- hasWriteAccessTo $ CNewsR tid ssh csh cID CNEditR
|
||||
mayDelete <- hasWriteAccessTo $ CNewsR tid ssh csh cID CNDeleteR
|
||||
return (cID, n, visible, files, lastEditText, mayEdit, mayDelete)
|
||||
return (cID, n, visible, files, lastEditText, mayEditNews, mayDelete)
|
||||
|
||||
events' <- fmap (sortOn $ courseEventTime . entityVal) . lift $ selectList [ CourseEventCourse ==. cid ] []
|
||||
events <- mapM (\(Entity evId ev) -> (, ev) <$> encrypt evId) events'
|
||||
@ -104,7 +106,7 @@ getCShowR tid ssh csh = do
|
||||
return $ submissionGroup E.^. SubmissionGroupName
|
||||
let submissionGroup = guardOnM (hasSubmissionGroups && is _Just registration) submissionGroup'
|
||||
|
||||
return (cid,course,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication,news,events,submissionGroup)
|
||||
return (cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication,news,events,submissionGroup,hasAllocationRegistrationOpen)
|
||||
|
||||
let mDereg' = maybe id min (allocationOverrideDeregister =<< mAllocation) <$> courseDeregisterUntil course
|
||||
mDereg <- traverse (formatTime SelFormatDateTime) mDereg'
|
||||
@ -216,10 +218,19 @@ getCShowR tid ssh csh = do
|
||||
, all (notElem pathSeparator . view _2) fs
|
||||
]
|
||||
hiddenEventNotes = all (\(_,CourseEvent{..}) -> is _Nothing courseEventNote) events
|
||||
Course{courseVisibleFrom,courseVisibleTo} = course
|
||||
mayCreateNews <- hasWriteAccessTo $ CourseR tid ssh csh CNewsNewR
|
||||
mayCreateEvents <- hasWriteAccessTo $ CourseR tid ssh csh CEventsNewR
|
||||
mayEdit <- hasWriteAccessTo $ CourseR tid ssh csh CEditR
|
||||
|
||||
siteLayout (toWgt $ courseName course) $ do
|
||||
let heading = [whamlet|
|
||||
$newline never
|
||||
^{courseName course}
|
||||
$if not courseVisible && mayEdit
|
||||
\ #{iconInvisible}
|
||||
|]
|
||||
|
||||
siteLayout heading $ do
|
||||
setTitleI $ prependCourseTitle tid ssh csh (""::Text)
|
||||
$(widgetFile "course")
|
||||
|
||||
|
||||
@ -28,23 +28,34 @@ import Handler.Submission.Upload
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
|
||||
|
||||
getSubmissionOwnR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
|
||||
-- For security reasons (unauthorized users not being allowed to have
|
||||
-- guesses about which sheets/courses exist confirmed) this handlers
|
||||
-- behaviour may not allow users to distinguish between:
|
||||
-- - course does not exist (answers 404)
|
||||
-- - course exists but sheet does not (answers 404)
|
||||
-- - course and sheet exist but user has no submission (answers 404)
|
||||
-- - course and sheet exist, user has submission, but is not
|
||||
-- authorized to know course/sheet/submission exists (impossible,
|
||||
-- because @!ownerANDread@ is sufficient for access to `SubShowR`;
|
||||
-- having access to `SubShowR` allows user to determine
|
||||
-- course/sheet from url)
|
||||
getSubmissionOwnR tid ssh csh shn = do
|
||||
authId <- requireAuthId
|
||||
sid <- runDB $ do
|
||||
shid <- fetchSheetId tid ssh csh shn
|
||||
submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do
|
||||
E.on (submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission)
|
||||
E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val authId
|
||||
E.&&. submission E.^. SubmissionSheet E.==. E.val shid
|
||||
sid <- runDB . maybeT notFound $ do
|
||||
submissions <- lift . E.select . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` submissionUser) -> do
|
||||
E.on $ submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission
|
||||
E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet
|
||||
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
|
||||
E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val authId
|
||||
E.&&. sheet E.^. SheetName E.==. E.val shn
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
return $ submission E.^. SubmissionId
|
||||
case submissions of
|
||||
(E.Value sid : _) -> return sid
|
||||
[] -> notFound
|
||||
hoistMaybe $ submissions ^? _head . _Value
|
||||
cID <- encrypt sid
|
||||
redirect $ CSubmissionR tid ssh csh shn cID SubShowR
|
||||
redirectAccess $ CSubmissionR tid ssh csh shn cID SubShowR
|
||||
|
||||
@ -5,7 +5,11 @@ module Handler.Term
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Course (mayViewCourse)
|
||||
|
||||
import Handler.Utils
|
||||
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
@ -62,11 +66,15 @@ validateTerm = do
|
||||
|
||||
getTermShowR :: Handler Html
|
||||
getTermShowR = do
|
||||
muid <- maybeAuthId
|
||||
now <- liftIO getCurrentTime
|
||||
ata <- getSessionActiveAuthTags
|
||||
table <- runDB $
|
||||
let termDBTable = DBTable{..}
|
||||
where dbtSQLQuery term = return (term, courseCount)
|
||||
where courseCount = E.subSelectCount . E.from $ \course ->
|
||||
E.where_ $ term E.^. TermId E.==. course E.^. CourseTerm
|
||||
E.&&. mayViewCourse muid ata now course Nothing
|
||||
dbtRowKey = (E.^. TermId)
|
||||
dbtProj = return . dbrOutput
|
||||
dbtColonnade = widgetColonnade $ mconcat
|
||||
|
||||
@ -529,7 +529,13 @@ data DBStyle r = DBStyle
|
||||
}
|
||||
|
||||
data DBSTemplateMode r = DBSTDefault { dbstmNumber :: Int64 -> Bool, dbstmShowNumber :: Int64 -> Bool }
|
||||
| DBSTCourse (Lens' r (Entity Course)) (Lens' r [Entity User]) (Lens' r Bool) (Lens' r (Entity School)) (Traversal' r (Entity Allocation))
|
||||
| DBSTCourse
|
||||
(Lens' r (Entity Course)) -- course
|
||||
(Lens' 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
|
||||
def = DBStyle
|
||||
@ -1323,13 +1329,17 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
DBSTDefault{} -> return $(widgetFile "table/cell/header")
|
||||
in do
|
||||
wHeaders <- maybe (return Nothing) (fmap Just . genHeaders (dbtColonnade ^. _Cornice)) pSortable
|
||||
now <- liftIO getCurrentTime
|
||||
case dbsTemplate of
|
||||
DBSTCourse c l r s a -> do
|
||||
DBSTCourse c l r s a e -> do
|
||||
wRows <- forM rows $ \row' -> let
|
||||
Course{..} = row' ^. c . _entityVal
|
||||
lecturerUsers = row' ^. l
|
||||
courseLecturers = userSurname . entityVal <$> lecturerUsers
|
||||
isRegistered = row' ^. r
|
||||
mayEdit = row' ^. e
|
||||
nmnow = NTop $ Just now
|
||||
courseIsVisible = NTop courseVisibleFrom <= nmnow && nmnow <= NTop courseVisibleTo
|
||||
courseSchoolName = schoolName $ row' ^. s . _entityVal
|
||||
courseSemester = (termToText . unTermKey) courseTerm
|
||||
courseAllocation = row' ^? a
|
||||
|
||||
@ -66,6 +66,7 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä
|
||||
| AuthTime
|
||||
| AuthStaffTime
|
||||
| AuthAllocationTime
|
||||
| AuthCourseTime
|
||||
| AuthMaterials
|
||||
| AuthOwner
|
||||
| AuthRated
|
||||
@ -121,6 +122,9 @@ instance Binary AuthTagActive where
|
||||
|
||||
derivePersistFieldJSON ''AuthTagActive
|
||||
|
||||
getSessionActiveAuthTags :: MonadHandler m => m AuthTagActive
|
||||
getSessionActiveAuthTags = fromMaybe def <$> lookupSessionJson SessionActiveAuthTags
|
||||
|
||||
|
||||
data PredLiteral a = PLVariable { plVar :: a } | PLNegated { plVar :: a }
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
|
||||
161
src/Utils/Course.hs
Normal file
161
src/Utils/Course.hs
Normal file
@ -0,0 +1,161 @@
|
||||
module Utils.Course
|
||||
( mayViewCourse, mayViewCourse', mayEditCourse, mayEditCourse'
|
||||
, isSchoolAdmin, isSchoolAdminLike
|
||||
, isCourseLecturer, isCourseTutor, isCourseSheetCorrector, isCourseExamCorrector
|
||||
, isCourseParticipant, isCourseApplicant
|
||||
, isCourseAssociated
|
||||
, courseIsVisible, courseIsVisible'
|
||||
, courseAllocationRegistrationOpen
|
||||
, numCourseParticipants
|
||||
) where
|
||||
|
||||
import Import.NoFoundation
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
|
||||
mayViewCourse :: Maybe UserId -> AuthTagActive -> UTCTime -> E.SqlExpr (Entity Course) -> Maybe (E.SqlExpr (E.Value AllocationId)) -> E.SqlExpr (E.Value Bool)
|
||||
mayViewCourse muid ata now course maid =
|
||||
isSchoolAdminLike muid ata (course E.^. CourseSchool)
|
||||
E.||. mayEditCourse muid ata course
|
||||
E.||. isCourseAssociated muid ata (course E.^. CourseId) maid
|
||||
E.||. courseIsVisible now course maid
|
||||
|
||||
mayViewCourse' :: Maybe UserId -> AuthTagActive -> UTCTime -> Entity Course -> Maybe AllocationId -> E.SqlExpr (E.Value Bool)
|
||||
mayViewCourse' muid ata now c@(Entity cid Course{courseSchool}) maid =
|
||||
isSchoolAdminLike muid ata (E.val courseSchool)
|
||||
E.||. mayEditCourse' muid ata c
|
||||
E.||. isCourseAssociated muid ata (E.val cid) (E.val <$> maid)
|
||||
E.||. courseIsVisible' now c maid
|
||||
|
||||
|
||||
mayEditCourse :: Maybe UserId -> AuthTagActive -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Bool)
|
||||
mayEditCourse muid ata course =
|
||||
isSchoolAdmin muid ata (course E.^. CourseSchool)
|
||||
E.||. isCourseLecturer muid ata (course E.^. CourseId)
|
||||
|
||||
mayEditCourse' :: Maybe UserId -> AuthTagActive -> Entity Course -> E.SqlExpr (E.Value Bool)
|
||||
mayEditCourse' muid ata (Entity cid Course{..}) =
|
||||
isSchoolAdmin muid ata (E.val courseSchool)
|
||||
E.||. isCourseLecturer muid ata (E.val cid)
|
||||
|
||||
|
||||
isSchoolAdmin :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value SchoolId) -> E.SqlExpr (E.Value Bool)
|
||||
isSchoolAdmin muid AuthTagActive{..} ssh
|
||||
| Just uid <- muid, authTagIsActive AuthAdmin = E.exists . E.from $ \(user `E.InnerJoin` userFunction) -> do
|
||||
E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
|
||||
E.where_ $ user E.^. UserId E.==. E.val uid
|
||||
E.&&. userFunction E.^. UserFunctionSchool E.==. ssh
|
||||
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin
|
||||
| otherwise = E.false
|
||||
|
||||
isSchoolAdminLike :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value SchoolId) -> E.SqlExpr (E.Value Bool)
|
||||
isSchoolAdminLike muid ata@AuthTagActive{..} ssh
|
||||
| Just uid <- muid = isSchoolAdmin muid ata ssh E.||. (E.exists . E.from $ \(user `E.InnerJoin` userFunction) -> do
|
||||
E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
|
||||
E.where_ $ user E.^. UserId E.==. E.val uid
|
||||
E.&&. userFunction E.^. UserFunctionSchool E.==. ssh
|
||||
E.&&. ( (userFunction E.^. UserFunctionFunction E.==. E.val SchoolEvaluation
|
||||
E.&&. E.val (authTagIsActive AuthEvaluation))
|
||||
E.||. (userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice
|
||||
E.&&. E.val (authTagIsActive AuthExamOffice))
|
||||
E.||. (userFunction E.^. UserFunctionFunction E.==. E.val SchoolAllocation
|
||||
E.&&. E.val (authTagIsActive AuthAllocationAdmin))
|
||||
)
|
||||
)
|
||||
| otherwise = E.false
|
||||
|
||||
isCourseLecturer :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
|
||||
isCourseLecturer muid AuthTagActive{..} cid
|
||||
| Just uid <- muid, authTagIsActive AuthLecturer = E.exists . E.from $ \(user `E.InnerJoin` lecturer) -> do
|
||||
E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
|
||||
E.where_ $ user E.^. UserId E.==. E.val uid
|
||||
E.&&. lecturer E.^. LecturerCourse E.==. cid
|
||||
| otherwise = E.false
|
||||
|
||||
isCourseTutor :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
|
||||
isCourseTutor muid AuthTagActive{..} cid
|
||||
| Just uid <- muid, authTagIsActive AuthTutor = E.exists . E.from $ \(tutor `E.InnerJoin` tutorial) -> do
|
||||
E.on $ tutor E.^. TutorTutorial E.==. tutorial E.^. TutorialId
|
||||
E.where_ $ tutor E.^. TutorUser E.==. E.val uid
|
||||
E.&&. tutorial E.^. TutorialCourse E.==. cid
|
||||
| otherwise = E.false
|
||||
|
||||
isCourseSheetCorrector :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
|
||||
isCourseSheetCorrector muid AuthTagActive{..} cid
|
||||
| Just uid <- muid, authTagIsActive AuthCorrector = E.exists . E.from $ \(sheetCorrector `E.InnerJoin` sheet) -> do
|
||||
E.on $ sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
|
||||
E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid
|
||||
E.&&. sheet E.^. SheetCourse E.==. cid
|
||||
| otherwise = E.false
|
||||
|
||||
isCourseExamCorrector :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
|
||||
isCourseExamCorrector muid AuthTagActive{..} cid
|
||||
| Just uid <- muid, authTagIsActive AuthExamCorrector = E.exists . E.from $ \(examCorrector `E.InnerJoin` exam) -> do
|
||||
E.on $ examCorrector E.^. ExamCorrectorExam E.==. exam E.^. ExamId
|
||||
E.where_ $ examCorrector E.^. ExamCorrectorUser E.==. E.val uid
|
||||
E.&&. exam E.^. ExamCourse E.==. cid
|
||||
| otherwise = E.false
|
||||
|
||||
isCourseParticipant :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
|
||||
isCourseParticipant muid AuthTagActive{..} cid
|
||||
| Just uid <- muid, authTagIsActive AuthCourseRegistered = E.exists . E.from $ \courseParticipant -> E.where_ $
|
||||
courseParticipant E.^. CourseParticipantUser E.==. E.val uid
|
||||
E.&&. courseParticipant E.^. CourseParticipantCourse E.==. cid
|
||||
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
E.&&. E.val (authTagIsActive AuthCourseRegistered)
|
||||
| otherwise = E.false
|
||||
|
||||
isCourseApplicant :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> Maybe (E.SqlExpr (E.Value AllocationId)) -> E.SqlExpr (E.Value Bool)
|
||||
isCourseApplicant muid AuthTagActive{..} cid maid
|
||||
| Just uid <- muid, authTagIsActive AuthApplicant = E.exists . E.from $ \courseApplication -> E.where_ $
|
||||
courseApplication E.^. CourseApplicationUser E.==. E.val uid
|
||||
E.&&. courseApplication E.^. CourseApplicationCourse E.==. cid
|
||||
E.&&. maybe E.true
|
||||
(\aid -> E.just aid E.==. courseApplication E.^. CourseApplicationAllocation)
|
||||
maid
|
||||
| otherwise = E.false
|
||||
|
||||
isCourseAssociated :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> Maybe (E.SqlExpr (E.Value AllocationId)) -> E.SqlExpr (E.Value Bool)
|
||||
isCourseAssociated muid ata cid maid =
|
||||
isCourseLecturer muid ata cid
|
||||
E.||. isCourseTutor muid ata cid
|
||||
E.||. isCourseSheetCorrector muid ata cid
|
||||
E.||. isCourseExamCorrector muid ata cid
|
||||
E.||. isCourseParticipant muid ata cid
|
||||
E.||. isCourseApplicant muid ata cid maid
|
||||
|
||||
|
||||
courseIsVisible :: UTCTime -> E.SqlExpr (Entity Course) -> Maybe (E.SqlExpr (E.Value AllocationId)) -> E.SqlExpr (E.Value Bool)
|
||||
courseIsVisible now course maid =
|
||||
(E.maybe E.false (\visibleFrom -> visibleFrom E.<=. E.val now) (course E.^. CourseVisibleFrom)
|
||||
E.&&. E.maybe E.true (\visibleTo -> E.val now E.<=. visibleTo) (course E.^. CourseVisibleTo)
|
||||
) E.||. courseAllocationRegistrationOpen now (course E.^. CourseId) maid
|
||||
|
||||
courseIsVisible' :: UTCTime -> Entity Course -> Maybe AllocationId -> E.SqlExpr (E.Value Bool)
|
||||
courseIsVisible' now (Entity cid Course{..}) maid =
|
||||
E.val (NTop courseVisibleFrom <= now' && now' <= NTop courseVisibleTo)
|
||||
E.||. courseAllocationRegistrationOpen now (E.val cid) (E.val <$> maid)
|
||||
where now' = NTop $ Just now
|
||||
|
||||
|
||||
courseAllocationRegistrationOpen :: UTCTime -> E.SqlExpr (E.Value CourseId) -> Maybe (E.SqlExpr (E.Value AllocationId)) -> E.SqlExpr (E.Value Bool)
|
||||
courseAllocationRegistrationOpen now cid maid = E.exists . E.from $ \(allocationCourse `E.InnerJoin` allocation) -> do
|
||||
E.on $ allocationCourse E.^. AllocationCourseAllocation E.==. allocation E.^. AllocationId
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. cid
|
||||
E.&&. E.maybe
|
||||
E.true
|
||||
(\registerFrom -> registerFrom E.<=. E.val now)
|
||||
(allocation E.^. AllocationRegisterFrom)
|
||||
E.&&. E.maybe
|
||||
E.true
|
||||
(\registerTo -> E.val now E.<=. registerTo)
|
||||
(allocation E.^. AllocationRegisterTo)
|
||||
E.&&. maybe E.true (\aid -> aid E.==. allocation E.^. AllocationId) maid
|
||||
|
||||
|
||||
numCourseParticipants :: E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Int)
|
||||
numCourseParticipants cid = E.subSelectCount . E.from $ \courseParticipant ->
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. cid
|
||||
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
@ -12,6 +12,8 @@ $if is _Just muid
|
||||
_{MsgAllocationNoApplication}
|
||||
<a .allocation-course__name href=@{CourseR courseTerm courseSchool courseShorthand CShowR} target="_blank">
|
||||
#{courseName}
|
||||
$if not courseVisible && mayEdit
|
||||
\ #{iconInvisible}
|
||||
$if hasApplicationTemplate || is _Just courseApplicationsInstructions
|
||||
<div .allocation-course__instructions-label .allocation__label>
|
||||
_{MsgCourseApplicationInstructionsApplication}
|
||||
|
||||
@ -8,7 +8,7 @@ $newline never
|
||||
<dd .deflist__dd>
|
||||
$if not (null news)
|
||||
<ul .course-news .list--iconless>
|
||||
$forall (cID, CourseNews{courseNewsTitle, courseNewsSummary, courseNewsContent}, isVisible, files, lastEditText, mayEdit, mayDelete) <- news
|
||||
$forall (cID, CourseNews{courseNewsTitle, courseNewsSummary, courseNewsContent}, isVisible, files, lastEditText, mayEditNews, mayDelete) <- news
|
||||
<li .course-news-item ##{"news-" <> toPathPiece cID}>
|
||||
$case (courseNewsTitle, courseNewsSummary)
|
||||
$# $of (Just title, Just summary)
|
||||
@ -50,9 +50,9 @@ $# #{summary}
|
||||
\ _{MsgCourseNewsFiles}
|
||||
<p .course-news-item__last-edit>
|
||||
_{MsgCourseNewsLastEdited lastEditText}
|
||||
$if mayEdit || mayDelete
|
||||
$if mayEditNews || mayDelete
|
||||
<ul .course-news-item__actions .list--inline .list--comma-separated>
|
||||
$if mayEdit
|
||||
$if mayEditNews
|
||||
<li>
|
||||
^{modal (i18n MsgCourseNewsActionEdit) (Left (SomeRoute (CNewsR tid ssh csh cID CNEditR)))}
|
||||
$if mayDelete
|
||||
@ -116,6 +116,7 @@ $# #{summary}
|
||||
<a href=#{link} target="_blank" rel="noopener" title="_{MsgCourseHomepageExternal}">
|
||||
#{iconLink}
|
||||
\ #{link}
|
||||
|
||||
$# $if NTop (Just 0) < NTop (courseCapacity course)
|
||||
<dt .deflist__dt>_{MsgCourseParticipantsHeading}
|
||||
<dd .deflist__dd>
|
||||
@ -123,6 +124,24 @@ $# $if NTop (Just 0) < NTop (courseCapacity course)
|
||||
_{MsgCourseParticipantsCountOf participants capacity}
|
||||
$nothing
|
||||
_{MsgCourseParticipantsCount participants}
|
||||
|
||||
$if mayEdit
|
||||
<dt .deflist__dt>
|
||||
$if isJust courseVisibleFrom && isNothing courseVisibleTo
|
||||
_{MsgCourseVisibleFrom}
|
||||
$else
|
||||
_{MsgCourseVisibility}
|
||||
\ #{iconInvisible}
|
||||
<dd .deflist__dd>
|
||||
<p>
|
||||
$maybe visFrom <- courseVisibleFrom
|
||||
^{formatTimeRangeW SelFormatDateTime visFrom courseVisibleTo}
|
||||
$if NTop (Just now) < NTop courseVisibleFrom
|
||||
$if hasAllocationRegistrationOpen
|
||||
_{MsgCourseInvisibleOverridenByAllocation}
|
||||
$else
|
||||
_{MsgCourseInvisible}
|
||||
|
||||
$maybe (Allocation{allocationName, allocationRegisterByCourse}, url) <- mAllocation'
|
||||
<dt .deflist__dt>_{MsgCourseAllocation}
|
||||
<dd .deflist__dd>
|
||||
@ -148,6 +167,7 @@ $# $if NTop (Just 0) < NTop (courseCapacity course)
|
||||
$maybe dereg <- mDereg
|
||||
<p .emph>
|
||||
_{MsgCourseDeregisterUntil dereg}
|
||||
|
||||
$maybe aInst <- courseApplicationsInstructions course
|
||||
<dt .deflist__dt>
|
||||
$if courseApplicationsRequired course
|
||||
@ -189,6 +209,7 @@ $# $if NTop (Just 0) < NTop (courseCapacity course)
|
||||
$nothing
|
||||
<i>
|
||||
_{MsgNoSubmissionGroup}
|
||||
|
||||
$if registrationOpen || isJust registration
|
||||
<dt .deflist__dt>
|
||||
_{MsgCourseRegistration}
|
||||
@ -210,6 +231,7 @@ $# $if NTop (Just 0) < NTop (courseCapacity course)
|
||||
$if isJust registration
|
||||
<p>
|
||||
_{MsgCourseRegistrationDeleteToEdit}
|
||||
|
||||
<dt .deflist__dt>
|
||||
_{MsgCourseMaterial}
|
||||
<dd .deflist__dd>
|
||||
@ -217,6 +239,7 @@ $# $if NTop (Just 0) < NTop (courseCapacity course)
|
||||
_{MsgCourseMaterialFree}
|
||||
$else
|
||||
_{MsgCourseMaterialNotFree}
|
||||
|
||||
$if hasExams
|
||||
<dt .deflist__dt>_{MsgCourseExams}
|
||||
<dd .deflist__dd>
|
||||
|
||||
@ -1,5 +1,12 @@
|
||||
$newline never
|
||||
<dl .deflist>
|
||||
<dt .deflist__dt>
|
||||
^{formatGregorianW 2020 08 10}
|
||||
<dd .deflist__dd>
|
||||
<ul>
|
||||
<li>
|
||||
Kurse haben nun einen Sichtbarkeitszeitraum.
|
||||
|
||||
<dt .deflist__dt>
|
||||
^{formatGregorianW 2020 07 20}
|
||||
<dd .deflist__dd>
|
||||
|
||||
@ -1,5 +1,12 @@
|
||||
$newline never
|
||||
<dl .deflist>
|
||||
<dt .deflist__dt>
|
||||
^{formatGregorianW 2020 08 10}
|
||||
<dd .deflist__dd>
|
||||
<ul>
|
||||
<li>
|
||||
Courses now have a visibility period.
|
||||
|
||||
<dt .deflist__dt>
|
||||
^{formatGregorianW 2020 07 20}
|
||||
<dd .deflist__dd>
|
||||
|
||||
@ -9,6 +9,8 @@
|
||||
<div .course-teaser__title>
|
||||
<a href=@{CourseR courseTerm courseSchool courseShorthand CShowR}>
|
||||
_{courseName}
|
||||
$if not courseIsVisible && mayEdit
|
||||
\ #{iconInvisible}
|
||||
$if isRegistered
|
||||
<div .course-teaser__registration>
|
||||
<span>_{MsgRegistered}
|
||||
|
||||
@ -21,11 +21,14 @@ $newline never
|
||||
<h3 .asidenav__box-subtitle>
|
||||
_{favReason}
|
||||
<ul .asidenav__list.list--iconless>
|
||||
$forall (Course{courseShorthand, courseName}, courseRoute, mPageActions, _) <- favouriteTermReason tid favReason
|
||||
$forall (Course{courseShorthand, courseName}, courseRoute, mPageActions, _, courseVisible, _, mayEdit) <- favouriteTermReason tid favReason
|
||||
<li .asidenav__list-item :highlight courseRoute:.asidenav__list-item--active>
|
||||
<a .asidenav__link-wrapper href=@{courseRoute}>
|
||||
<div .asidenav__link-shorthand>#{courseShorthand}
|
||||
<div .asidenav__link-label>#{courseName}
|
||||
<div .asidenav__link-label>
|
||||
#{courseName}
|
||||
$if mayEdit && not courseVisible
|
||||
\ #{iconInvisible}
|
||||
<div .asidenav__nested-list-wrapper>
|
||||
$maybe pageActions <- mPageActions
|
||||
<ul .asidenav__nested-list.list--iconless>
|
||||
|
||||
@ -546,6 +546,8 @@ fillDb = do
|
||||
, courseTerm = TermKey $ seasonTerm True Summer
|
||||
, courseSchool = ifi
|
||||
, courseCapacity = Just 20
|
||||
, courseVisibleFrom = Just now
|
||||
, courseVisibleTo = Nothing
|
||||
, courseRegisterFrom = Just $ termTime True Summer (-2) False Monday toMidnight
|
||||
, courseRegisterTo = Just $ termTime True Summer 0 True Sunday beforeMidnight
|
||||
, courseDeregisterUntil = Nothing
|
||||
@ -658,6 +660,8 @@ fillDb = do
|
||||
, courseTerm = TermKey $ seasonTerm False Winter
|
||||
, courseSchool = ifi
|
||||
, courseCapacity = Just 20
|
||||
, courseVisibleFrom = Just now
|
||||
, courseVisibleTo = Nothing
|
||||
, courseRegisterFrom = Just $ termTime False Winter (-4) False Monday toMidnight
|
||||
, courseRegisterTo = Nothing
|
||||
, courseDeregisterUntil = Nothing
|
||||
@ -682,6 +686,8 @@ fillDb = do
|
||||
, courseTerm = TermKey $ seasonTerm True Summer
|
||||
, courseSchool = ifi
|
||||
, courseCapacity = Just 20
|
||||
, courseVisibleFrom = Just now
|
||||
, courseVisibleTo = Nothing
|
||||
, courseRegisterFrom = Just $ termTime True Summer 0 False Monday toMidnight
|
||||
, courseRegisterTo = Just $ termTime True Summer (-2) True Sunday beforeMidnight
|
||||
, courseDeregisterUntil = Nothing
|
||||
@ -706,6 +712,8 @@ fillDb = do
|
||||
, courseTerm = TermKey $ seasonTerm True Winter
|
||||
, courseSchool = ifi
|
||||
, courseCapacity = Just 30
|
||||
, courseVisibleFrom = Just now
|
||||
, courseVisibleTo = Nothing
|
||||
, courseRegisterFrom = Nothing
|
||||
, courseRegisterTo = Nothing
|
||||
, courseDeregisterUntil = Nothing
|
||||
@ -730,6 +738,8 @@ fillDb = do
|
||||
, courseTerm = TermKey $ seasonTerm True Summer
|
||||
, courseSchool = ifi
|
||||
, courseCapacity = Just 50
|
||||
, courseVisibleFrom = Just now
|
||||
, courseVisibleTo = Nothing
|
||||
, courseRegisterFrom = Just $ termTime True Summer (-2) False Monday toMidnight
|
||||
, courseRegisterTo = Nothing
|
||||
, courseDeregisterUntil = Nothing
|
||||
@ -898,6 +908,8 @@ fillDb = do
|
||||
, courseTerm = TermKey $ seasonTerm False Winter
|
||||
, courseSchool = ifi
|
||||
, courseCapacity = Just 50
|
||||
, courseVisibleFrom = Just now
|
||||
, courseVisibleTo = Nothing
|
||||
, courseRegisterFrom = Nothing
|
||||
, courseRegisterTo = Nothing
|
||||
, courseDeregisterUntil = Nothing
|
||||
@ -1028,6 +1040,8 @@ fillDb = do
|
||||
, courseTerm = TermKey $ seasonTerm False Winter
|
||||
, courseSchool = ifi
|
||||
, courseCapacity = Just 50
|
||||
, courseVisibleFrom = Just now
|
||||
, courseVisibleTo = Nothing
|
||||
, courseRegisterFrom = Nothing
|
||||
, courseRegisterTo = Nothing
|
||||
, courseDeregisterUntil = Nothing
|
||||
@ -1098,6 +1112,8 @@ fillDb = do
|
||||
, courseTerm = TermKey $ seasonTerm False Winter
|
||||
, courseSchool = ifi
|
||||
, courseCapacity = Just 50
|
||||
, courseVisibleFrom = Just now
|
||||
, courseVisibleTo = Nothing
|
||||
, courseRegisterFrom = Nothing
|
||||
, courseRegisterTo = Nothing
|
||||
, courseDeregisterUntil = Nothing
|
||||
@ -1153,6 +1169,8 @@ fillDb = do
|
||||
, courseTerm = TermKey $ seasonTerm False Winter
|
||||
, courseSchool = ifi
|
||||
, courseCapacity = Just cap
|
||||
, courseVisibleFrom = Just now
|
||||
, courseVisibleTo = Nothing
|
||||
, courseRegisterFrom = Nothing
|
||||
, courseRegisterTo = Nothing
|
||||
, courseDeregisterUntil = Nothing
|
||||
|
||||
Loading…
Reference in New Issue
Block a user