feat(allocations): merge notifications
This commit is contained in:
parent
31150fc843
commit
9e9e53e76a
@ -2234,25 +2234,45 @@ SynchroniseLdapUserQueued n@Int: LDAP-Synchronisation von #{n} #{pluralDE n "Ben
|
|||||||
SynchroniseLdapAllUsersQueued: LDAP-Synchronisation von allen Benutzern angestoßen
|
SynchroniseLdapAllUsersQueued: LDAP-Synchronisation von allen Benutzern angestoßen
|
||||||
UserHijack: Sitzung übernehmen
|
UserHijack: Sitzung übernehmen
|
||||||
|
|
||||||
MailSubjectAllocationStaffRegister allocation@AllocationName: Sie können nun Kurse für die Zentralameldung „#{allocation}“ registrieren
|
MailAllocationSchoolAndName allocationSchool@SchoolId allocation@AllocationName: #{allocationSchool}: „#{allocation}“
|
||||||
MailAllocationStaffRegisterNewCourse: Sie können auf der unten aufgeführten Seite neue Kurse in Uni2work anlegen. Hierbei haben Sie die Möglichkeit anzugeben, dass der Kurs an der Zentralanmeldung teilnimmt.
|
|
||||||
MailAllocationStaffRegisterDeadline deadline@Text: Bitte beachten Sie, dass alle Kurse, die an der Zentralanmeldung teilnehmen, bis #{deadline} eingetragen sein müssen.
|
|
||||||
|
|
||||||
MailSubjectAllocationRegister allocation@AllocationName: Sie können sich nun für Kurse der Zentralameldung „#{allocation}“ bewerben
|
MailSubjectAllocationStaffRegister allocationSchool@SchoolId allocation@AllocationName: Sie können nun Kurse für die Zentralameldung #{allocationSchool}: „#{allocation}“ registrieren
|
||||||
MailAllocationRegister: Sie können sich, auf der unten aufgeführten Seite, für alle Kurse der Zentralanmeldung jeweils einzeln bewerben.
|
MailSubjectAllocationStaffRegisterMultiple n@Int: Sie können nun Kurse für #{n} Zentralameldungen registrieren
|
||||||
|
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 Uni2work 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
|
||||||
|
|
||||||
|
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
|
||||||
|
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.
|
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
|
||||||
|
|
||||||
MailSubjectAllocationAllocation allocation@AllocationName: Sie können nun Bewerbungen für ihre Kurse in der Zentralanmeldung „#{allocation}“ bewerten
|
|
||||||
MailAllocationAllocation: Sie können nun auf den unten aufgeführten Seiten Bewerbungen, die im Rahmen der Zentralanmeldung an ihre Kurse gestellt wurden, bewerten. Die Bewertungen werden bei der Vergabe der Plätze berücksichtigt.
|
MailSubjectAllocationAllocation allocationSchool@SchoolId allocation@AllocationName: Sie können nun Bewerbungen für ihre Kurse in der Zentralanmeldung #{allocationSchool}: „#{allocation}“ bewerten
|
||||||
|
MailSubjectAllocationAllocationMultiple n@Int: Sie können nun Bewerbungen für ihre Kurse in #{n} Zentralanmeldungen bewerten
|
||||||
|
MailAllocationAllocationIntroMultiple n@Int: Sie können nun 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.
|
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.
|
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.
|
||||||
|
|
||||||
MailSubjectAllocationUnratedApplications allocation@AllocationName: Es stehen noch Bewertungen zu Bewerbungen für ihre Kurse in der Zentralanmeldung „#{allocation}“ aus
|
MailSubjectAllocationUnratedApplications allocationSchool@SchoolId allocation@AllocationName: Es stehen noch Bewertungen zu Bewerbungen für ihre Kurse in der Zentralanmeldung #{allocationSchool}: „#{allocation}“ aus
|
||||||
MailAllocationUnratedApplications: Für die unten aufgeführten Kurse liegen Bewerbungen vor, die im Rahmen der Zentralanmeldung an den jeweiligen Kurs gestellt wurden, die noch nicht bewertet wurden.
|
MailSubjectAllocationUnratedApplicationsMultiple n@Int: Es stehen noch Bewertungen zu Bewerbungen für ihre Kurse in #{n} Zentralanmeldungen aus
|
||||||
|
MailAllocationUnratedApplicationsIntroMultiple n@Int: Es stehen noch Bewertungen zu Bewerbungen für ihre Kurse in #{n} Zentralanmeldungen aus:
|
||||||
MailSubjectAllocationOutdatedRatings allocation@AllocationName: Bereits bewertete Bewerbungen für ihre Kurse in der Zentralanmeldung „#{allocation}“ haben sich geändert
|
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 und deswegen neu bewertet werden müssen.
|
||||||
MailAllocationOutdatedRatings: Für die unten aufgeführten Kurse liegen Bewerbungen vor, die im Rahmen der Zentralanmeldung an den jeweiligen Kurs gestellt wurden, die sich verändert haben, seit sie zuletzt bewertet wurden.
|
MailAllocationUnratedApplicationsCount i@Natural: #{i} #{pluralDE i "Bewerbung" "Bewerbungen"}
|
||||||
MailAllocationOutdatedRatingsWarning: Bewerbungen deren Bewertung veraltet ist (d.h. die Bewerbung wurde nach der Bewertung verändert) zählen als nicht bewertet.
|
|
||||||
|
|
||||||
ExamOfficeSubscribedUsers: Benutzer
|
ExamOfficeSubscribedUsers: Benutzer
|
||||||
ExamOfficeSubscribedUsersTip: Sie können mehrere Matrikelnummern mit Komma separieren
|
ExamOfficeSubscribedUsersTip: Sie können mehrere Matrikelnummern mit Komma separieren
|
||||||
|
|||||||
@ -2234,25 +2234,45 @@ SynchroniseLdapUserQueued n: Triggered LDAP synchronisation of #{n} #{pluralEN n
|
|||||||
SynchroniseLdapAllUsersQueued: Triggered LDAP synchronisation of all users
|
SynchroniseLdapAllUsersQueued: Triggered LDAP synchronisation of all users
|
||||||
UserHijack: Hijack session
|
UserHijack: Hijack session
|
||||||
|
|
||||||
MailSubjectAllocationStaffRegister allocation: You may now register courses for the central allocation “#{allocation}”
|
MailAllocationSchoolAndName allocationSchool allocation: #{allocationSchool}: “#{allocation}”
|
||||||
MailAllocationStaffRegisterNewCourse: You can create new courses on the page linked below. While doing so you now have to option to specifiy that the course should participate in the central allocation.
|
|
||||||
MailAllocationStaffRegisterDeadline deadline: Please consider that alle courses must be registered until #{deadline} in order to participate in the central allocation.
|
|
||||||
|
|
||||||
MailSubjectAllocationRegister allocation: You may now apply for the central allocation “#{allocation}”
|
MailSubjectAllocationStaffRegister allocationSchool allocation: You can now register courses for the central allocation #{allocationSchool}: “#{allocation}”
|
||||||
MailAllocationRegister: You may now apply for each individual course particpating in the central allocation on the page linked below.
|
MailSubjectAllocationStaffRegisterMultiple n: You can now register courses for #{n} central allocations
|
||||||
MailAllocationRegisterDeadline deadline: Please consider that all applications have to be made until #{deadline}.
|
MailAllocationStaffRegisterIntroMultiple n: You can now register courses for the following #{n} central allocations:
|
||||||
|
MailAllocationStaffRegisterNewCourse: You can create new courses in Uni2work 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
|
||||||
|
|
||||||
MailSubjectAllocationAllocation allocation: You may now grade applications made to your courses for the central allocation “#{allocation}”
|
MailSubjectAllocationRegister allocationSchool allocation: Applications can now be made for courses of the central allocation #{allocationSchool}: “#{allocation}”
|
||||||
MailAllocationAllocation: On the page linked below you may now grade applications made to your corses for the central allocation. The grades you specify will be considered during the allocation process.
|
MailSubjectAllocationRegisterMultiple n: Applications can now be made for courses of #{n} central allocations
|
||||||
MailAllocationApplicationsMayChange deadline: Please consider that students may continue to apply, retract, and edit their applications until #{deadline}. Applications that change after being graded will need to be graded again.
|
MailAllocationRegisterIntroMultiple n: Applications can now be made for courses of the following #{n} central allocations:
|
||||||
MailAllocationAllocationDeadline deadline: Please consider that grading of applications is only possible until #{deadline}.
|
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
|
||||||
|
|
||||||
MailSubjectAllocationUnratedApplications allocation: Some applications made to your courses for the central allocation “#{allocation}” are not yet graded
|
|
||||||
MailAllocationUnratedApplications: Applications have been made to the courses listed below for the central allocation, which have not yet been graded.
|
|
||||||
|
|
||||||
MailSubjectAllocationOutdatedRatings allocation: Applications made to your courses for the central allocation “#{allocation}” have changed since being graded
|
MailSubjectAllocationAllocation allocationSchool allocation: You can now rate applications for your courses that participate in the central allocation #{allocationSchool}: “#{allocation}”
|
||||||
MailAllocationOutdatedRatings: Applications have been made to the courses list below for the central allocation, which have changed since they were last graded.
|
MailSubjectAllocationAllocationMultiple n: You can now rate applications for your courses that participate in #{n} central allocations
|
||||||
MailAllocationOutdatedRatingsWarning: Applications whose grading is deprecated (i.e. that have been changed since they were graded) are considered not to have been graded during the allocation process.
|
MailAllocationAllocationIntroMultiple n: You can now 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).
|
||||||
|
|
||||||
|
MailSubjectAllocationUnratedApplications allocationSchool allocation: There are unrated applications for you courses participating in the central allocation #{allocationSchool}: “#{allocation}”
|
||||||
|
MailSubjectAllocationUnratedApplicationsMultiple n: There are unrated applications for your courses participating in #{n} central allocations
|
||||||
|
MailAllocationUnratedApplicationsIntroMultiple n: There are unrated applications for your courses participating 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.
|
||||||
|
MailAllocationUnratedApplicationsCount i: #{i} #{pluralDE i "application" "applications"}
|
||||||
|
|
||||||
ExamOfficeSubscribedUsers: Users
|
ExamOfficeSubscribedUsers: Users
|
||||||
ExamOfficeSubscribedUsersTip: You may specify multiple matriculations; comma-separated
|
ExamOfficeSubscribedUsersTip: You may specify multiple matriculations; comma-separated
|
||||||
|
|||||||
@ -373,69 +373,64 @@ determineCrontab = execWriterT $ do
|
|||||||
|
|
||||||
runConduit $ transPipe lift (selectKeys [] []) .| C.mapM_ externalExamJobs
|
runConduit $ transPipe lift (selectKeys [] []) .| C.mapM_ externalExamJobs
|
||||||
|
|
||||||
|
|
||||||
|
allocations <- lift $ selectList [] []
|
||||||
|
|
||||||
let
|
let
|
||||||
allocationJobs (Entity nAllocation Allocation{..}) = do
|
allocationTimes :: EntityField Allocation (Maybe UTCTime) -> MergeHashMap UTCTime [Entity Allocation]
|
||||||
whenIsJust allocationStaffRegisterFrom $ \staffRegisterFrom ->
|
allocationTimes aField = flip foldMap allocations $ \allocEnt -> case allocEnt ^. fieldLens aField of
|
||||||
tell $ HashMap.singleton
|
Nothing -> mempty
|
||||||
(JobCtlQueue $ JobQueueNotification NotificationAllocationStaffRegister{..})
|
Just t -> _MergeHashMap # HashMap.singleton t (pure allocEnt)
|
||||||
Cron
|
|
||||||
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ staffRegisterFrom
|
|
||||||
, cronRepeat = CronRepeatOnChange
|
|
||||||
, cronRateLimit = appNotificationRateLimit
|
|
||||||
, cronNotAfter = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationStaffRegisterTo
|
|
||||||
}
|
|
||||||
whenIsJust allocationRegisterFrom $ \registerFrom ->
|
|
||||||
tell $ HashMap.singleton
|
|
||||||
(JobCtlQueue $ JobQueueNotification NotificationAllocationRegister{..})
|
|
||||||
Cron
|
|
||||||
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ registerFrom
|
|
||||||
, cronRepeat = CronRepeatOnChange
|
|
||||||
, cronRateLimit = appNotificationRateLimit
|
|
||||||
, cronNotAfter = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationRegisterTo
|
|
||||||
}
|
|
||||||
whenIsJust allocationStaffAllocationFrom $ \allocationFrom ->
|
|
||||||
tell $ HashMap.singleton
|
|
||||||
(JobCtlQueue $ JobQueueNotification NotificationAllocationAllocation{..})
|
|
||||||
Cron
|
|
||||||
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ allocationFrom
|
|
||||||
, cronRepeat = CronRepeatOnChange
|
|
||||||
, cronRateLimit = appNotificationRateLimit
|
|
||||||
, cronNotAfter = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationStaffAllocationTo
|
|
||||||
}
|
|
||||||
case allocationRegisterTo of
|
|
||||||
Just registerTo
|
|
||||||
| maybe True (> registerTo) allocationStaffAllocationTo
|
|
||||||
-> do
|
|
||||||
tell $ HashMap.singleton
|
|
||||||
(JobCtlQueue $ JobQueueNotification NotificationAllocationUnratedApplications{..})
|
|
||||||
Cron
|
|
||||||
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ registerTo
|
|
||||||
, cronRepeat = CronRepeatOnChange
|
|
||||||
, cronRateLimit = appNotificationRateLimit
|
|
||||||
, cronNotAfter = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationStaffAllocationTo
|
|
||||||
}
|
|
||||||
tell $ HashMap.singleton
|
|
||||||
(JobCtlQueue $ JobQueueNotification NotificationAllocationOutdatedRatings{..})
|
|
||||||
Cron
|
|
||||||
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ registerTo
|
|
||||||
, cronRepeat = CronRepeatOnChange
|
|
||||||
, cronRateLimit = appNotificationRateLimit
|
|
||||||
, cronNotAfter = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationStaffAllocationTo
|
|
||||||
}
|
|
||||||
_other
|
|
||||||
-> return ()
|
|
||||||
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' ->
|
forM_ allocations $ \(Entity nAllocation _) -> do
|
||||||
tell $ HashMap.singleton
|
doneSince <- lift $ fmap (E.unValue <=< listToMaybe) . E.select . E.from $ \participant -> do
|
||||||
(JobCtlQueue $ JobQueueNotification NotificationAllocationResults{..})
|
E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
|
||||||
Cron
|
return . E.max_ $ participant E.^. CourseParticipantRegistration
|
||||||
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay doneSince'
|
|
||||||
, cronRepeat = CronRepeatOnChange
|
|
||||||
, cronRateLimit = appNotificationRateLimit
|
|
||||||
, cronNotAfter = Right . CronTimestamp . utcToLocalTimeTZ appTZ . addUTCTime appNotificationCollateDelay $ addUTCTime appNotificationExpiration doneSince'
|
|
||||||
}
|
|
||||||
|
|
||||||
runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ allocationJobs
|
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
|
||||||
|
}
|
||||||
|
|||||||
@ -19,246 +19,266 @@ import qualified Data.Conduit.Combinators as C
|
|||||||
|
|
||||||
|
|
||||||
dispatchJobQueueNotification :: Notification -> JobHandler UniWorX
|
dispatchJobQueueNotification :: Notification -> JobHandler UniWorX
|
||||||
dispatchJobQueueNotification jNotification = JobHandlerAtomic $ do
|
dispatchJobQueueNotification jNotification = JobHandlerAtomic $
|
||||||
nClass <- hoist lift $ classifyNotification jNotification
|
runConduit $ yield jNotification
|
||||||
runConduit $ transPipe (hoist lift) (determineNotificationCandidates jNotification)
|
.| transPipe (hoist lift) determineNotificationCandidates
|
||||||
.| C.filter (\(Entity _ User{userNotificationSettings}) -> notificationAllowed userNotificationSettings nClass)
|
.| C.filterM (\(notification', Entity _ User{userNotificationSettings}) -> notificationAllowed userNotificationSettings <$> hoist lift (classifyNotification notification'))
|
||||||
.| C.map (flip JobSendNotification jNotification . entityKey) .| sinkDBJobs
|
.| C.map (\(notification', Entity uid _) -> JobSendNotification uid notification')
|
||||||
|
.| sinkDBJobs
|
||||||
|
|
||||||
|
|
||||||
determineNotificationCandidates :: Notification -> ConduitT () (Entity User) DB ()
|
determineNotificationCandidates :: ConduitT Notification (Notification, Entity User) DB ()
|
||||||
determineNotificationCandidates NotificationSubmissionRated{..}
|
determineNotificationCandidates = awaitForever $ \notif -> do
|
||||||
= E.selectSource . E.from $ \(user `E.InnerJoin` submissionUser) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
let withNotif :: ConduitT () (Entity User) DB () -> ConduitT Notification (Notification, Entity User) DB ()
|
||||||
E.on $ user E.^. UserId E.==. submissionUser E.^. SubmissionUserUser
|
withNotif c = toProducer c .| C.map (notif, )
|
||||||
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val nSubmission
|
|
||||||
return user
|
|
||||||
determineNotificationCandidates NotificationSheetActive{..}
|
|
||||||
= E.selectSource . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
|
||||||
E.on $ sheet E.^. SheetCourse E.==. courseParticipant E.^. CourseParticipantCourse
|
|
||||||
E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
|
|
||||||
E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
|
||||||
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
|
|
||||||
return user
|
|
||||||
determineNotificationCandidates NotificationSheetHint{..}
|
|
||||||
= E.selectSource . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
|
||||||
E.on $ sheet E.^. SheetCourse E.==. courseParticipant E.^. CourseParticipantCourse
|
|
||||||
E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
|
|
||||||
E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
|
||||||
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
|
|
||||||
return user
|
|
||||||
determineNotificationCandidates NotificationSheetSolution{..}
|
|
||||||
= E.selectSource . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
|
||||||
E.on $ sheet E.^. SheetCourse E.==. courseParticipant E.^. CourseParticipantCourse
|
|
||||||
E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
|
|
||||||
E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
|
||||||
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
|
|
||||||
return user
|
|
||||||
determineNotificationCandidates NotificationSheetSoonInactive{..}
|
|
||||||
= E.selectSource . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
|
||||||
E.on $ sheet E.^. SheetCourse E.==. courseParticipant E.^. CourseParticipantCourse
|
|
||||||
E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
|
|
||||||
E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
|
||||||
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
|
|
||||||
return user
|
|
||||||
determineNotificationCandidates NotificationSheetInactive{..}
|
|
||||||
= E.selectSource . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
|
||||||
E.on $ lecturer E.^. LecturerCourse E.==. sheet E.^. SheetCourse
|
|
||||||
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
|
|
||||||
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
|
|
||||||
return user
|
|
||||||
determineNotificationCandidates NotificationCorrectionsAssigned{..}
|
|
||||||
= selectSource [UserId ==. nUser] []
|
|
||||||
determineNotificationCandidates NotificationCorrectionsNotDistributed{nSheet}
|
|
||||||
= E.selectSource . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
|
||||||
E.on $ lecturer E.^. LecturerCourse E.==. sheet E.^. SheetCourse
|
|
||||||
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
|
|
||||||
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
|
|
||||||
return user
|
|
||||||
determineNotificationCandidates NotificationUserRightsUpdate{..} = do
|
|
||||||
-- always send to affected user
|
|
||||||
affectedUser <- lift $ selectList [UserId ==. nUser] []
|
|
||||||
-- send to same-school admins only if there was an update
|
|
||||||
currentAdminSchools <- lift $ setOf (folded . _entityVal . _userFunctionSchool) <$> selectList [UserFunctionUser ==. nUser, UserFunctionFunction ==. SchoolAdmin] []
|
|
||||||
let oldAdminSchools = setOf (folded . filtered ((== SchoolAdmin) . view _1) . _2 . from _SchoolId) nOriginalRights
|
|
||||||
newAdminSchools = currentAdminSchools `Set.difference` oldAdminSchools
|
|
||||||
affectedAdmins <- lift . E.select . E.from $ \(user `E.InnerJoin` admin) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
|
||||||
E.on $ admin E.^. UserFunctionUser E.==. user E.^. UserId
|
|
||||||
E.where_ $ admin E.^. UserFunctionSchool `E.in_` E.valList (Set.toList newAdminSchools)
|
|
||||||
E.&&. admin E.^. UserFunctionFunction E.==. E.val SchoolAdmin
|
|
||||||
return user
|
|
||||||
yieldMany . nub $ affectedUser <> affectedAdmins
|
|
||||||
determineNotificationCandidates NotificationUserAuthModeUpdate{..}
|
|
||||||
= selectSource [UserId ==. nUser] []
|
|
||||||
determineNotificationCandidates NotificationExamRegistrationActive{..} =
|
|
||||||
E.selectSource . E.from $ \(exam `E.InnerJoin` courseParticipant `E.InnerJoin` user) -> do
|
|
||||||
E.on $ courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId
|
|
||||||
E.on $ courseParticipant E.^. CourseParticipantCourse E.==. exam E.^. ExamCourse
|
|
||||||
E.where_ $ exam E.^. ExamId E.==. E.val nExam
|
|
||||||
E.where_ . E.not_ . E.exists . E.from $ \examRegistration ->
|
|
||||||
E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
|
|
||||||
E.&&. examRegistration E.^. ExamRegistrationExam E.==. E.val nExam
|
|
||||||
E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
|
||||||
return user
|
|
||||||
determineNotificationCandidates NotificationExamRegistrationSoonInactive{..} =
|
|
||||||
E.selectSource . E.from $ \(exam `E.InnerJoin` courseParticipant `E.InnerJoin` user) -> do
|
|
||||||
E.on $ courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId
|
|
||||||
E.on $ courseParticipant E.^. CourseParticipantCourse E.==. exam E.^. ExamCourse
|
|
||||||
E.where_ $ exam E.^. ExamId E.==. E.val nExam
|
|
||||||
E.where_ . E.not_ . E.exists . E.from $ \examRegistration ->
|
|
||||||
E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
|
|
||||||
E.&&. examRegistration E.^. ExamRegistrationExam E.==. E.val nExam
|
|
||||||
E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
|
||||||
return user
|
|
||||||
determineNotificationCandidates NotificationExamDeregistrationSoonInactive{..} =
|
|
||||||
E.selectSource . E.from $ \(examRegistration `E.InnerJoin` user) -> do
|
|
||||||
E.on $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
|
|
||||||
E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val nExam
|
|
||||||
return user
|
|
||||||
determineNotificationCandidates notif@NotificationExamResult{..} = do
|
|
||||||
lastExec <- lift . fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif
|
|
||||||
E.selectSource . E.from $ \(examResult `E.InnerJoin` user) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
|
||||||
E.on $ examResult E.^. ExamResultUser E.==. user E.^. UserId
|
|
||||||
E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam
|
|
||||||
whenIsJust lastExec $ \lastExec' ->
|
|
||||||
E.where_ $ examResult E.^. ExamResultLastChanged E.>. E.val lastExec'
|
|
||||||
return user
|
|
||||||
determineNotificationCandidates NotificationAllocationStaffRegister{..} = do
|
|
||||||
Allocation{..} <- lift $ getJust nAllocation
|
|
||||||
E.selectSource . E.from $ \(user `E.InnerJoin` userFunction) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
|
||||||
E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
|
|
||||||
E.&&. userFunction E.^. UserFunctionSchool E.==. E.val allocationSchool
|
|
||||||
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolLecturer
|
|
||||||
|
|
||||||
E.where_ . E.exists . E.from $ \userSchool ->
|
-- | Assumes that conduit produces output sorted by `UserId`
|
||||||
E.where_ $ userSchool E.^. UserSchoolUser E.==. user E.^. UserId
|
separateTargets :: Ord target
|
||||||
E.&&. userSchool E.^. UserSchoolSchool E.==. E.val allocationSchool
|
=> (Set target -> Notification)
|
||||||
E.&&. E.not_ (userSchool E.^. UserSchoolIsOptOut)
|
-> ConduitT () (Entity User, E.Value target) DB ()
|
||||||
|
-> ConduitT Notification (Notification, 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, uent)
|
||||||
|
Just next'@(uent', E.Value t)
|
||||||
|
| ((==) `on` entityKey) uent uent' -> go (Just uent) $ Set.insert t ts
|
||||||
|
| otherwise -> yield (mkNotif' ts, uent) >> leftover next' >> go Nothing Set.empty
|
||||||
|
|
||||||
E.where_ . E.not_ . E.exists . E.from $ \(course `E.InnerJoin` lecturer) -> do
|
case notif of
|
||||||
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
|
NotificationSubmissionRated{..}
|
||||||
E.&&. lecturer E.^. LecturerUser E.==. user E.^. UserId
|
-> withNotif . E.selectSource . E.from $ \(user `E.InnerJoin` submissionUser) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
||||||
E.where_ . E.exists . E.from $ \allocationCourse ->
|
E.on $ user E.^. UserId E.==. submissionUser E.^. SubmissionUserUser
|
||||||
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val nSubmission
|
||||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
|
return user
|
||||||
|
NotificationSheetActive{..}
|
||||||
|
-> withNotif . E.selectSource . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
||||||
|
E.on $ sheet E.^. SheetCourse E.==. courseParticipant E.^. CourseParticipantCourse
|
||||||
|
E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
|
||||||
|
E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||||
|
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
|
||||||
|
return user
|
||||||
|
NotificationSheetHint{..}
|
||||||
|
-> withNotif . E.selectSource . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
||||||
|
E.on $ sheet E.^. SheetCourse E.==. courseParticipant E.^. CourseParticipantCourse
|
||||||
|
E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
|
||||||
|
E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||||
|
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
|
||||||
|
return user
|
||||||
|
NotificationSheetSolution{..}
|
||||||
|
-> withNotif . E.selectSource . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
||||||
|
E.on $ sheet E.^. SheetCourse E.==. courseParticipant E.^. CourseParticipantCourse
|
||||||
|
E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
|
||||||
|
E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||||
|
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
|
||||||
|
return user
|
||||||
|
NotificationSheetSoonInactive{..}
|
||||||
|
-> withNotif . E.selectSource . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
||||||
|
E.on $ sheet E.^. SheetCourse E.==. courseParticipant E.^. CourseParticipantCourse
|
||||||
|
E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
|
||||||
|
E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||||
|
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
|
||||||
|
return user
|
||||||
|
NotificationSheetInactive{..}
|
||||||
|
-> withNotif . E.selectSource . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
||||||
|
E.on $ lecturer E.^. LecturerCourse E.==. sheet E.^. SheetCourse
|
||||||
|
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
|
||||||
|
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
|
||||||
|
return user
|
||||||
|
NotificationCorrectionsAssigned{..}
|
||||||
|
-> withNotif $ selectSource [UserId ==. nUser] []
|
||||||
|
NotificationCorrectionsNotDistributed{nSheet}
|
||||||
|
-> withNotif . E.selectSource . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
||||||
|
E.on $ lecturer E.^. LecturerCourse E.==. sheet E.^. SheetCourse
|
||||||
|
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
|
||||||
|
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
|
||||||
|
return user
|
||||||
|
NotificationUserRightsUpdate{..}
|
||||||
|
-> do
|
||||||
|
-- always send to affected user
|
||||||
|
affectedUser <- lift $ selectList [UserId ==. nUser] []
|
||||||
|
-- send to same-school admins only if there was an update
|
||||||
|
currentAdminSchools <- lift $ setOf (folded . _entityVal . _userFunctionSchool) <$> selectList [UserFunctionUser ==. nUser, UserFunctionFunction ==. SchoolAdmin] []
|
||||||
|
let oldAdminSchools = setOf (folded . filtered ((== SchoolAdmin) . view _1) . _2 . from _SchoolId) nOriginalRights
|
||||||
|
newAdminSchools = currentAdminSchools `Set.difference` oldAdminSchools
|
||||||
|
affectedAdmins <- lift . E.select . E.from $ \(user `E.InnerJoin` admin) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
||||||
|
E.on $ admin E.^. UserFunctionUser E.==. user E.^. UserId
|
||||||
|
E.where_ $ admin E.^. UserFunctionSchool `E.in_` E.valList (Set.toList newAdminSchools)
|
||||||
|
E.&&. admin E.^. UserFunctionFunction E.==. E.val SchoolAdmin
|
||||||
|
return user
|
||||||
|
withNotif . yieldMany . nub $ affectedUser <> affectedAdmins
|
||||||
|
NotificationUserAuthModeUpdate{..}
|
||||||
|
-> withNotif $ selectSource [UserId ==. nUser] []
|
||||||
|
NotificationExamRegistrationActive{..}
|
||||||
|
-> withNotif . E.selectSource . E.from $ \(exam `E.InnerJoin` courseParticipant `E.InnerJoin` user) -> do
|
||||||
|
E.on $ courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId
|
||||||
|
E.on $ courseParticipant E.^. CourseParticipantCourse E.==. exam E.^. ExamCourse
|
||||||
|
E.where_ $ exam E.^. ExamId E.==. E.val nExam
|
||||||
|
E.where_ . E.not_ . E.exists . E.from $ \examRegistration ->
|
||||||
|
E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
|
||||||
|
E.&&. examRegistration E.^. ExamRegistrationExam E.==. E.val nExam
|
||||||
|
E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||||
|
return user
|
||||||
|
NotificationExamRegistrationSoonInactive{..}
|
||||||
|
-> withNotif . E.selectSource . E.from $ \(exam `E.InnerJoin` courseParticipant `E.InnerJoin` user) -> do
|
||||||
|
E.on $ courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId
|
||||||
|
E.on $ courseParticipant E.^. CourseParticipantCourse E.==. exam E.^. ExamCourse
|
||||||
|
E.where_ $ exam E.^. ExamId E.==. E.val nExam
|
||||||
|
E.where_ . E.not_ . E.exists . E.from $ \examRegistration ->
|
||||||
|
E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
|
||||||
|
E.&&. examRegistration E.^. ExamRegistrationExam E.==. E.val nExam
|
||||||
|
E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||||
|
return user
|
||||||
|
NotificationExamDeregistrationSoonInactive{..}
|
||||||
|
-> withNotif . E.selectSource . E.from $ \(examRegistration `E.InnerJoin` user) -> do
|
||||||
|
E.on $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
|
||||||
|
E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val nExam
|
||||||
|
return user
|
||||||
|
NotificationExamResult{..}
|
||||||
|
-> do
|
||||||
|
lastExec <- lift . fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif
|
||||||
|
withNotif . E.selectSource . E.from $ \(examResult `E.InnerJoin` user) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
||||||
|
E.on $ examResult E.^. ExamResultUser E.==. user E.^. UserId
|
||||||
|
E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam
|
||||||
|
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
|
||||||
|
|
||||||
return user
|
E.where_ $ userFunction E.^. UserFunctionFunction E.==. E.val SchoolLecturer
|
||||||
determineNotificationCandidates NotificationAllocationAllocation{..} =
|
E.&&. allocation E.^. AllocationId `E.in_` E.valList (Set.toList nAllocations)
|
||||||
E.selectSource . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
|
||||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
|
||||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
|
|
||||||
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
|
|
||||||
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
|
|
||||||
|
|
||||||
E.where_ . E.not_ . E.exists . E.from $ \application ->
|
E.where_ . E.exists . E.from $ \userSchool ->
|
||||||
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
|
E.where_ $ userSchool E.^. UserSchoolUser E.==. user E.^. UserId
|
||||||
E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId
|
E.&&. userSchool E.^. UserSchoolSchool E.==. allocation E.^. AllocationSchool
|
||||||
E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId
|
E.&&. E.not_ (userSchool E.^. UserSchoolIsOptOut)
|
||||||
E.&&. E.not_ (E.isNothing $ application E.^. CourseApplicationRatingTime)
|
|
||||||
|
|
||||||
E.where_ . E.exists . E.from $ \application ->
|
E.where_ . E.not_ . E.exists . E.from $ \(course `E.InnerJoin` lecturer) -> do
|
||||||
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
|
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
|
||||||
E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId
|
E.&&. lecturer E.^. LecturerUser E.==. user E.^. UserId
|
||||||
E.&&. application E.^. CourseApplicationUser 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
|
return (user, allocation E.^. AllocationId)
|
||||||
determineNotificationCandidates NotificationAllocationUnratedApplications{..} =
|
NotificationAllocationRegister{..}
|
||||||
E.selectSource . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
-> 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 $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
E.on E.true
|
||||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
|
|
||||||
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
|
|
||||||
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
|
|
||||||
|
|
||||||
E.where_ . E.exists . E.from $ \application ->
|
E.where_ $ allocation E.^. AllocationId `E.in_` E.valList (Set.toList nAllocations)
|
||||||
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
|
|
||||||
E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId
|
|
||||||
E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId
|
|
||||||
E.&&. E.isNothing (application E.^. CourseApplicationRatingTime)
|
|
||||||
|
|
||||||
return user
|
E.where_ . E.exists . E.from $ \userSchool ->
|
||||||
determineNotificationCandidates NotificationAllocationRegister{..} = do
|
E.where_ $ userSchool E.^. UserSchoolUser E.==. user E.^. UserId
|
||||||
Allocation{..} <- lift $ getJust nAllocation
|
E.&&. userSchool E.^. UserSchoolSchool E.==. allocation E.^. AllocationSchool
|
||||||
E.selectSource . E.from $ \user -> do
|
E.&&. E.not_ (userSchool E.^. UserSchoolIsOptOut)
|
||||||
E.where_ . E.exists . E.from $ \userSchool ->
|
|
||||||
E.where_ $ userSchool E.^. UserSchoolUser E.==. user E.^. UserId
|
|
||||||
E.&&. userSchool E.^. UserSchoolSchool E.==. E.val allocationSchool
|
|
||||||
E.&&. E.not_ (userSchool E.^. UserSchoolIsOptOut)
|
|
||||||
|
|
||||||
E.where_ . E.not_ . E.exists . E.from $ \application ->
|
E.where_ . E.not_ . E.exists . E.from $ \application ->
|
||||||
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
|
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (allocation E.^. AllocationId)
|
||||||
E.&&. application E.^. CourseApplicationUser E.==. user E.^. UserId
|
E.&&. application E.^. CourseApplicationUser E.==. user E.^. UserId
|
||||||
|
|
||||||
return user
|
return (user, allocation E.^. AllocationId)
|
||||||
determineNotificationCandidates NotificationAllocationOutdatedRatings{..} =
|
NotificationAllocationAllocation{..}
|
||||||
E.selectSource . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
-> 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 $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
|
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
|
||||||
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
|
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
|
||||||
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
|
|
||||||
|
|
||||||
E.where_ . E.exists . E.from $ \application ->
|
E.where_ $ allocationCourse E.^. AllocationCourseAllocation `E.in_` E.valList (Set.toList nAllocations)
|
||||||
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
|
|
||||||
E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId
|
|
||||||
E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId
|
|
||||||
E.&&. E.maybe E.false (E.<. application E.^. CourseApplicationTime) (application E.^. CourseApplicationRatingTime)
|
|
||||||
|
|
||||||
return user
|
E.where_ . E.not_ . E.exists . E.from $ \application ->
|
||||||
determineNotificationCandidates NotificationExamOfficeExamResults{..} =
|
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
|
||||||
E.selectSource . E.from $ \user -> do
|
E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId
|
||||||
E.where_ . E.exists . E.from $ \examResult -> do
|
E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId
|
||||||
E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam
|
E.&&. E.not_ (E.isNothing $ application E.^. CourseApplicationRatingTime)
|
||||||
E.where_ $ examOfficeExamResultAuth (user E.^. UserId) examResult
|
|
||||||
return user
|
|
||||||
determineNotificationCandidates NotificationExamOfficeExamResultsChanged{..} =
|
|
||||||
E.selectSource . E.from $ \user -> do
|
|
||||||
E.where_ . E.exists . E.from $ \examResult -> do
|
|
||||||
E.where_ $ examResult E.^. ExamResultId `E.in_` E.valList (Set.toList nExamResults)
|
|
||||||
E.where_ $ examOfficeExamResultAuth (user E.^. UserId) examResult
|
|
||||||
return user
|
|
||||||
determineNotificationCandidates NotificationExamOfficeExternalExamResults{..} =
|
|
||||||
E.selectSource . E.from $ \user -> do
|
|
||||||
E.where_ . E.exists . E.from $ \externalExamResult -> do
|
|
||||||
E.where_ $ externalExamResult E.^. ExternalExamResultExam E.==. E.val nExternalExam
|
|
||||||
E.where_ $ examOfficeExternalExamResultAuth (user E.^. UserId) externalExamResult
|
|
||||||
return user
|
|
||||||
determineNotificationCandidates notif@NotificationAllocationResults{..} = do
|
|
||||||
lastExec <- lift . fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif
|
|
||||||
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_ . E.exists . E.from $ \application ->
|
||||||
E.where_ $ participant E.^. CourseParticipantUser E.==. user E.^. UserId
|
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
|
||||||
E.&&. participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
|
E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId
|
||||||
E.&&. participant E.^. CourseParticipantRegistration E.>. E.val t
|
E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId
|
||||||
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
|
return (user, allocationCourse E.^. AllocationCourseAllocation)
|
||||||
determineNotificationCandidates NotificationCourseRegistered{..} =
|
NotificationAllocationUnratedApplications{..}
|
||||||
yieldMMany $ getEntity nUser
|
-> 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
|
||||||
determineNotificationCandidates NotificationSubmissionEdited{..} =
|
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||||
E.selectSource . E.from $ \(user `E.InnerJoin` submissionUser) -> do
|
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
|
||||||
E.on $ user E.^. UserId E.==. submissionUser E.^. SubmissionUserUser
|
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
|
||||||
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val nSubmission
|
|
||||||
E.&&. user E.^. UserId E.!=. E.val nInitiator
|
E.where_ $ allocationCourse E.^. AllocationCourseAllocation `E.in_` E.valList (Set.toList nAllocations)
|
||||||
return user
|
|
||||||
determineNotificationCandidates NotificationSubmissionUserCreated{..} =
|
E.where_ . E.exists . E.from $ \application ->
|
||||||
yieldMMany $ getEntity nUser
|
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
|
||||||
determineNotificationCandidates NotificationSubmissionUserDeleted{..} =
|
E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId
|
||||||
yieldMMany $ getEntity nUser
|
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
|
||||||
|
E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam
|
||||||
|
E.where_ $ examOfficeExamResultAuth (user E.^. UserId) examResult
|
||||||
|
return user
|
||||||
|
NotificationExamOfficeExamResultsChanged{..}
|
||||||
|
-> withNotif . E.selectSource . E.from $ \user -> do
|
||||||
|
E.where_ . E.exists . E.from $ \examResult -> do
|
||||||
|
E.where_ $ examResult E.^. ExamResultId `E.in_` E.valList (Set.toList nExamResults)
|
||||||
|
E.where_ $ examOfficeExamResultAuth (user E.^. UserId) examResult
|
||||||
|
return user
|
||||||
|
NotificationExamOfficeExternalExamResults{..}
|
||||||
|
-> withNotif . E.selectSource . E.from $ \user -> do
|
||||||
|
E.where_ . E.exists . E.from $ \externalExamResult -> 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{..}
|
||||||
|
-> withNotif . E.selectSource . E.from $ \(user `E.InnerJoin` submissionUser) -> do
|
||||||
|
E.on $ user E.^. UserId E.==. submissionUser E.^. SubmissionUserUser
|
||||||
|
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val nSubmission
|
||||||
|
E.&&. user E.^. UserId E.!=. E.val nInitiator
|
||||||
|
return user
|
||||||
|
NotificationSubmissionUserCreated{..}
|
||||||
|
-> withNotif . yieldMMany $ getEntity nUser
|
||||||
|
NotificationSubmissionUserDeleted{..}
|
||||||
|
-> withNotif . yieldMMany $ getEntity nUser
|
||||||
|
|
||||||
|
|
||||||
classifyNotification :: Notification -> DB NotificationTrigger
|
classifyNotification :: Notification -> DB NotificationTrigger
|
||||||
@ -283,7 +303,6 @@ classifyNotification NotificationExamResult{} = return NTExa
|
|||||||
classifyNotification NotificationAllocationStaffRegister{} = return NTAllocationStaffRegister
|
classifyNotification NotificationAllocationStaffRegister{} = return NTAllocationStaffRegister
|
||||||
classifyNotification NotificationAllocationAllocation{} = return NTAllocationAllocation
|
classifyNotification NotificationAllocationAllocation{} = return NTAllocationAllocation
|
||||||
classifyNotification NotificationAllocationRegister{} = return NTAllocationRegister
|
classifyNotification NotificationAllocationRegister{} = return NTAllocationRegister
|
||||||
classifyNotification NotificationAllocationOutdatedRatings{} = return NTAllocationOutdatedRatings
|
|
||||||
classifyNotification NotificationAllocationUnratedApplications{} = return NTAllocationUnratedApplications
|
classifyNotification NotificationAllocationUnratedApplications{} = return NTAllocationUnratedApplications
|
||||||
classifyNotification NotificationExamOfficeExamResults{} = return NTExamOfficeExamResults
|
classifyNotification NotificationExamOfficeExamResults{} = return NTExamOfficeExamResults
|
||||||
classifyNotification NotificationExamOfficeExamResultsChanged{} = return NTExamOfficeExamResultsChanged
|
classifyNotification NotificationExamOfficeExamResultsChanged{} = return NTExamOfficeExamResultsChanged
|
||||||
|
|||||||
@ -5,7 +5,6 @@ module Jobs.Handler.SendNotification.Allocation
|
|||||||
, dispatchNotificationAllocationRegister
|
, dispatchNotificationAllocationRegister
|
||||||
, dispatchNotificationAllocationAllocation
|
, dispatchNotificationAllocationAllocation
|
||||||
, dispatchNotificationAllocationUnratedApplications
|
, dispatchNotificationAllocationUnratedApplications
|
||||||
, dispatchNotificationAllocationOutdatedRatings
|
|
||||||
, dispatchNotificationAllocationResults
|
, dispatchNotificationAllocationResults
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@ -20,137 +19,122 @@ import qualified Database.Esqueleto as E
|
|||||||
import qualified Database.Esqueleto.Utils as E
|
import qualified Database.Esqueleto.Utils as E
|
||||||
|
|
||||||
|
|
||||||
dispatchNotificationAllocationStaffRegister :: AllocationId -> UserId -> Handler ()
|
dispatchNotificationAllocationStaffRegister :: Set AllocationId -> UserId -> Handler ()
|
||||||
dispatchNotificationAllocationStaffRegister nAllocation jRecipient = userMailT jRecipient $ do
|
dispatchNotificationAllocationStaffRegister (otoList -> nAllocations) jRecipient = userMailT jRecipient $ do
|
||||||
Allocation{..} <- liftHandler . runDB $ getJust nAllocation
|
allocs <- fmap (sortOn $ \Allocation{..} -> (allocationSchool, allocationName)) . liftHandler . runDB $ mapM getJust nAllocations
|
||||||
|
|
||||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||||
setSubjectI $ MsgMailSubjectAllocationStaffRegister allocationName
|
case allocs of
|
||||||
|
[Allocation{..}] ->
|
||||||
|
setSubjectI $ MsgMailSubjectAllocationStaffRegister allocationSchool allocationName
|
||||||
|
_other ->
|
||||||
|
setSubjectI . MsgMailSubjectAllocationStaffRegisterMultiple $ length allocs
|
||||||
editNotifications <- mkEditNotifications jRecipient
|
editNotifications <- mkEditNotifications jRecipient
|
||||||
registerDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffRegisterTo
|
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")
|
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationStaffRegister.hamlet")
|
||||||
|
|
||||||
dispatchNotificationAllocationRegister :: AllocationId -> UserId -> Handler ()
|
dispatchNotificationAllocationRegister :: Set AllocationId -> UserId -> Handler ()
|
||||||
dispatchNotificationAllocationRegister nAllocation jRecipient = userMailT jRecipient $ do
|
dispatchNotificationAllocationRegister (otoList -> nAllocations) jRecipient = userMailT jRecipient $ do
|
||||||
Allocation{..} <- liftHandler . runDB $ getJust nAllocation
|
allocs <- fmap (sortOn $ \Allocation{..} -> (allocationSchool, allocationName)) . liftHandler . runDB $ mapM getJust nAllocations
|
||||||
|
|
||||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||||
setSubjectI $ MsgMailSubjectAllocationRegister allocationName
|
case allocs of
|
||||||
|
[Allocation{..}] ->
|
||||||
|
setSubjectI $ MsgMailSubjectAllocationRegister allocationSchool allocationName
|
||||||
|
_other ->
|
||||||
|
setSubjectI . MsgMailSubjectAllocationRegisterMultiple $ length allocs
|
||||||
editNotifications <- mkEditNotifications jRecipient
|
editNotifications <- mkEditNotifications jRecipient
|
||||||
registerDeadline <- traverse (formatTime SelFormatDateTime) allocationRegisterTo
|
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")
|
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationRegister.hamlet")
|
||||||
|
|
||||||
dispatchNotificationAllocationAllocation :: AllocationId -> UserId -> Handler ()
|
dispatchNotificationAllocationAllocation :: Set AllocationId -> UserId -> Handler ()
|
||||||
dispatchNotificationAllocationAllocation nAllocation jRecipient = do
|
dispatchNotificationAllocationAllocation (otoList -> nAllocations) jRecipient = do
|
||||||
(Allocation{..}, courses) <- runDB $ do
|
courses <- fmap (nubOn $ views _2 entityKey) . runDB . E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` allocation `E.InnerJoin` lecturer) -> do
|
||||||
allocation <- getJust nAllocation
|
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
|
||||||
courses <- E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` lecturer) -> do
|
E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
|
||||||
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
|
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||||
E.&&. lecturer E.^. LecturerUser E.==. E.val jRecipient
|
|
||||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
E.where_ $ lecturer E.^. LecturerUser E.==. E.val jRecipient
|
||||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
|
E.where_ $ allocation E.^. AllocationId `E.in_` E.valList nAllocations
|
||||||
return ( course E.^. CourseTerm
|
|
||||||
, course E.^. CourseSchool
|
E.orderBy [ E.asc $ allocation E.^. AllocationSchool
|
||||||
, course E.^. CourseShorthand
|
, E.asc $ allocation E.^. AllocationName
|
||||||
, course E.^. CourseName
|
, E.asc $ course E.^. CourseTerm
|
||||||
)
|
, E.asc $ course E.^. CourseSchool
|
||||||
let courses' = courses
|
, E.asc $ course E.^. CourseName
|
||||||
& over (traverse . _1) E.unValue
|
]
|
||||||
& over (traverse . _2) E.unValue
|
|
||||||
& over (traverse . _3) E.unValue
|
return (allocation, course)
|
||||||
& over (traverse . _4) E.unValue
|
|
||||||
return (allocation, courses')
|
let allocations = nubOn entityKey $ courses ^.. folded . _1
|
||||||
|
|
||||||
unless (null courses) . userMailT jRecipient $ do
|
unless (null courses) . userMailT jRecipient $ do
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
|
let doRegisterDeadlines = any (> NTop (Just now)) $ map (NTop . allocationRegisterTo . entityVal) allocations
|
||||||
|
|
||||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||||
setSubjectI $ MsgMailSubjectAllocationAllocation allocationName
|
case allocations of
|
||||||
|
[Entity _ Allocation{..}]
|
||||||
|
-> setSubjectI $ MsgMailSubjectAllocationAllocation allocationSchool allocationName
|
||||||
|
_other
|
||||||
|
-> setSubjectI . MsgMailSubjectAllocationAllocationMultiple $ length allocations
|
||||||
editNotifications <- mkEditNotifications jRecipient
|
editNotifications <- mkEditNotifications jRecipient
|
||||||
allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
|
|
||||||
registerDeadline <- traverse (formatTime SelFormatDateTime) $ assertM (> now) allocationRegisterTo
|
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")
|
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationAllocation.hamlet")
|
||||||
|
|
||||||
dispatchNotificationAllocationUnratedApplications :: AllocationId -> UserId -> Handler ()
|
dispatchNotificationAllocationUnratedApplications :: Set AllocationId -> UserId -> Handler ()
|
||||||
dispatchNotificationAllocationUnratedApplications nAllocation jRecipient = do
|
dispatchNotificationAllocationUnratedApplications (otoList -> nAllocations) jRecipient = do
|
||||||
(Allocation{..}, courses) <- runDB $ do
|
courses <- fmap (nubOn (views _2 entityKey) . over (traverse . _3) E.unValue) . runDB . E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` allocation `E.InnerJoin` lecturer) -> do
|
||||||
allocation <- getJust nAllocation
|
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
|
||||||
courses <- E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` lecturer) -> do
|
E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
|
||||||
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
|
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||||
E.&&. lecturer E.^. LecturerUser E.==. E.val jRecipient
|
|
||||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
|
||||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
|
|
||||||
|
|
||||||
let
|
E.where_ $ lecturer E.^. LecturerUser E.==. E.val jRecipient
|
||||||
unratedAppCount :: E.SqlExpr (E.Value Natural)
|
E.where_ $ allocation E.^. AllocationId `E.in_` E.valList nAllocations
|
||||||
unratedAppCount = E.subSelectCount . E.from $ \application ->
|
|
||||||
E.where_ $ application E.^. CourseApplicationCourse E.==. course E.^. CourseId
|
|
||||||
E.&&. application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
|
|
||||||
E.&&. E.isNothing (application E.^. CourseApplicationRatingTime)
|
|
||||||
|
|
||||||
return ( course E.^. CourseTerm
|
let
|
||||||
, course E.^. CourseSchool
|
unratedAppCount :: E.SqlExpr (E.Value Natural)
|
||||||
, course E.^. CourseShorthand
|
unratedAppCount = E.subSelectCount . E.from $ \application ->
|
||||||
, course E.^. CourseName
|
E.where_ $ application E.^. CourseApplicationCourse E.==. course E.^. CourseId
|
||||||
, unratedAppCount
|
E.&&. application E.^. CourseApplicationAllocation E.==. E.just (allocation E.^. AllocationId)
|
||||||
)
|
E.&&. E.maybe E.true (E.<. application E.^. CourseApplicationTime) (application E.^. CourseApplicationRatingTime)
|
||||||
let courses' = courses
|
|
||||||
& over (traverse . _1) E.unValue
|
|
||||||
& over (traverse . _2) E.unValue
|
|
||||||
& over (traverse . _3) E.unValue
|
|
||||||
& over (traverse . _4) E.unValue
|
|
||||||
& over (traverse . _5) E.unValue
|
|
||||||
& filter ((> 0) . view _5)
|
|
||||||
return (allocation, courses')
|
|
||||||
|
|
||||||
|
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 = nubOn entityKey $ courses ^.. folded . _1
|
||||||
|
|
||||||
unless (null courses) . userMailT jRecipient $ do
|
unless (null courses) . userMailT jRecipient $ do
|
||||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||||
setSubjectI $ MsgMailSubjectAllocationUnratedApplications allocationName
|
case allocations of
|
||||||
|
[Entity _ Allocation{..}]
|
||||||
|
-> setSubjectI $ MsgMailSubjectAllocationUnratedApplications allocationSchool allocationName
|
||||||
|
_other
|
||||||
|
-> setSubjectI . MsgMailSubjectAllocationUnratedApplicationsMultiple $ length allocations
|
||||||
editNotifications <- mkEditNotifications jRecipient
|
editNotifications <- mkEditNotifications jRecipient
|
||||||
allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
|
|
||||||
|
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")
|
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationUnratedApplications.hamlet")
|
||||||
|
|
||||||
dispatchNotificationAllocationOutdatedRatings :: AllocationId -> UserId -> Handler ()
|
|
||||||
dispatchNotificationAllocationOutdatedRatings nAllocation jRecipient = do
|
|
||||||
(Allocation{..}, courses) <- runDB $ do
|
|
||||||
allocation <- getJust nAllocation
|
|
||||||
courses <- E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` lecturer) -> do
|
|
||||||
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
|
|
||||||
E.&&. lecturer E.^. LecturerUser E.==. E.val jRecipient
|
|
||||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
|
||||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
|
|
||||||
|
|
||||||
let
|
|
||||||
outdatedRatingsAppCount :: E.SqlExpr (E.Value Natural)
|
|
||||||
outdatedRatingsAppCount = E.subSelectCount . E.from $ \application ->
|
|
||||||
E.where_ $ application E.^. CourseApplicationCourse E.==. course E.^. CourseId
|
|
||||||
E.&&. application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
|
|
||||||
E.&&. E.maybe E.false (E.<. application E.^. CourseApplicationTime) (application E.^. CourseApplicationRatingTime)
|
|
||||||
|
|
||||||
return ( course E.^. CourseTerm
|
|
||||||
, course E.^. CourseSchool
|
|
||||||
, course E.^. CourseShorthand
|
|
||||||
, course E.^. CourseName
|
|
||||||
, outdatedRatingsAppCount
|
|
||||||
)
|
|
||||||
let courses' = courses
|
|
||||||
& over (traverse . _1) E.unValue
|
|
||||||
& over (traverse . _2) E.unValue
|
|
||||||
& over (traverse . _3) E.unValue
|
|
||||||
& over (traverse . _4) E.unValue
|
|
||||||
& over (traverse . _5) E.unValue
|
|
||||||
& filter ((> 0) . view _5)
|
|
||||||
return (allocation, courses')
|
|
||||||
|
|
||||||
|
|
||||||
unless (null courses) . userMailT jRecipient $ do
|
|
||||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
|
||||||
setSubjectI $ MsgMailSubjectAllocationOutdatedRatings allocationName
|
|
||||||
editNotifications <- mkEditNotifications jRecipient
|
|
||||||
allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
|
|
||||||
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationOutdatedRatings.hamlet")
|
|
||||||
|
|
||||||
dispatchNotificationAllocationResults :: AllocationId -> UserId -> Handler ()
|
dispatchNotificationAllocationResults :: AllocationId -> UserId -> Handler ()
|
||||||
dispatchNotificationAllocationResults nAllocation jRecipient = userMailT jRecipient $ do
|
dispatchNotificationAllocationResults nAllocation jRecipient = userMailT jRecipient $ do
|
||||||
(Allocation{..}, lecturerResults, participantResults) <- liftHandler . runDB $ do
|
(Allocation{..}, lecturerResults, participantResults) <- liftHandler . runDB $ do
|
||||||
|
|||||||
@ -101,11 +101,10 @@ data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
|
|||||||
| NotificationExamRegistrationSoonInactive { nExam :: ExamId }
|
| NotificationExamRegistrationSoonInactive { nExam :: ExamId }
|
||||||
| NotificationExamDeregistrationSoonInactive { nExam :: ExamId }
|
| NotificationExamDeregistrationSoonInactive { nExam :: ExamId }
|
||||||
| NotificationExamResult { nExam :: ExamId }
|
| NotificationExamResult { nExam :: ExamId }
|
||||||
| NotificationAllocationStaffRegister { nAllocation :: AllocationId }
|
| NotificationAllocationStaffRegister { nAllocations :: Set AllocationId }
|
||||||
| NotificationAllocationRegister { nAllocation :: AllocationId }
|
| NotificationAllocationRegister { nAllocations :: Set AllocationId }
|
||||||
| NotificationAllocationAllocation { nAllocation :: AllocationId }
|
| NotificationAllocationAllocation { nAllocations :: Set AllocationId }
|
||||||
| NotificationAllocationUnratedApplications { nAllocation :: AllocationId }
|
| NotificationAllocationUnratedApplications { nAllocations :: Set AllocationId }
|
||||||
| NotificationAllocationOutdatedRatings { nAllocation :: AllocationId }
|
|
||||||
| NotificationExamOfficeExamResults { nExam :: ExamId }
|
| NotificationExamOfficeExamResults { nExam :: ExamId }
|
||||||
| NotificationExamOfficeExamResultsChanged { nExamResults :: Set ExamResultId }
|
| NotificationExamOfficeExamResultsChanged { nExamResults :: Set ExamResultId }
|
||||||
| NotificationExamOfficeExternalExamResults { nExternalExam :: ExternalExamId }
|
| NotificationExamOfficeExternalExamResults { nExternalExam :: ExternalExamId }
|
||||||
|
|||||||
@ -9,24 +9,58 @@ $newline never
|
|||||||
font-variant: small-caps;
|
font-variant: small-caps;
|
||||||
font-weight: normal;
|
font-weight: normal;
|
||||||
}
|
}
|
||||||
|
.bold {
|
||||||
|
font-weight: bold;
|
||||||
|
}
|
||||||
<body>
|
<body>
|
||||||
<h1>
|
<h1>
|
||||||
_{SomeMessage $ MsgMailSubjectAllocationAllocation allocationName}
|
$case allocations
|
||||||
|
$of [Entity _ Allocation{allocationSchool, allocationName}]
|
||||||
|
_{SomeMessage $ MsgMailSubjectAllocationAllocation allocationSchool allocationName}
|
||||||
|
$of _
|
||||||
|
_{SomeMessage $ MsgMailAllocationAllocationIntroMultiple (length allocations)}
|
||||||
|
|
||||||
<p>
|
<p>
|
||||||
_{SomeMessage MsgMailAllocationAllocation}
|
_{SomeMessage $ MsgMailAllocationAllocation (length allocations)}
|
||||||
<ul>
|
<ul>
|
||||||
$forall (tid, ssh, csh, cName) <- courses
|
$forall (Entity _ Allocation{allocationSchool, allocationName}, Entity _ Course{courseTerm, courseSchool, courseShorthand, courseName}) <- courses
|
||||||
<li>
|
<li>
|
||||||
<a href=@{CourseR tid ssh csh CApplicationsR}>
|
<a href=@{CourseR courseTerm courseSchool courseShorthand CApplicationsR}>
|
||||||
#{cName}
|
#{courseName} (_{SomeMessage $ MsgMailAllocationSchoolAndName allocationSchool allocationName})
|
||||||
|
|
||||||
$maybe until <- registerDeadline
|
$if doDeadlines
|
||||||
<p>
|
$if sameDeadlines
|
||||||
_{SomeMessage $ MsgMailAllocationApplicationsMayChange until}
|
$maybe (_, registerDeadline, allocationDeadline) <- preview _head deadlines
|
||||||
|
$maybe until <- guardOnM doRegisterDeadlines registerDeadline
|
||||||
|
<p>
|
||||||
|
_{SomeMessage $ MsgMailAllocationApplicationsMayChange until}
|
||||||
|
|
||||||
|
$maybe until <- allocationDeadline
|
||||||
|
<p>
|
||||||
|
_{SomeMessage $ MsgMailAllocationAllocationDeadline until}
|
||||||
|
$else
|
||||||
|
$if doRegisterDeadlines
|
||||||
|
<p>
|
||||||
|
_{SomeMessage MsgMailAllocationApplicationsMayChangeMultiple}
|
||||||
|
<p>
|
||||||
|
_{SomeMessage MsgMailAllocationAllocationDeadlineMultiple}
|
||||||
|
|
||||||
|
<ul>
|
||||||
|
$forall (Allocation{allocationSchool, allocationName}, registerDeadline, allocationDeadline) <- deadlines
|
||||||
|
<li>
|
||||||
|
<p .bold>
|
||||||
|
_{SomeMessage $ MsgMailAllocationSchoolAndName allocationSchool allocationName}
|
||||||
|
$if doRegisterDeadlines
|
||||||
|
<p>
|
||||||
|
$maybe until <- registerDeadline
|
||||||
|
_{SomeMessage $ MsgMailAllocationApplicationsRegisterDeadline until}
|
||||||
|
$nothing
|
||||||
|
_{SomeMessage MsgMailAllocationApplicationsRegisterDeadlineNothing}
|
||||||
|
<p>
|
||||||
|
$maybe until <- allocationDeadline
|
||||||
|
_{SomeMessage $ MsgMailAllocationApplicationsAllocationDeadline until}
|
||||||
|
$nothing
|
||||||
|
_{SomeMessage MsgMailAllocationApplicationsAllocationDeadlineNothing}
|
||||||
|
|
||||||
$maybe until <- allocationDeadline
|
|
||||||
<p>
|
|
||||||
_{SomeMessage $ MsgMailAllocationAllocationDeadline until}
|
|
||||||
|
|
||||||
^{ihamletSomeMessage editNotifications}
|
^{ihamletSomeMessage editNotifications}
|
||||||
|
|||||||
@ -9,18 +9,50 @@ $newline never
|
|||||||
font-variant: small-caps;
|
font-variant: small-caps;
|
||||||
font-weight: normal;
|
font-weight: normal;
|
||||||
}
|
}
|
||||||
|
.bold {
|
||||||
|
font-weight: bold;
|
||||||
|
}
|
||||||
<body>
|
<body>
|
||||||
<h1>
|
<h1>
|
||||||
_{SomeMessage $ MsgMailSubjectAllocationRegister allocationName}
|
$case allocs
|
||||||
|
$of [Allocation{allocationSchool, allocationName}]
|
||||||
|
_{SomeMessage $ MsgMailSubjectAllocationRegister allocationSchool allocationName}
|
||||||
|
$of _
|
||||||
|
_{SomeMessage $ MsgMailAllocationRegisterIntroMultiple (length allocs)}
|
||||||
|
|
||||||
<p>
|
<p>
|
||||||
_{SomeMessage MsgMailAllocationRegister}
|
_{SomeMessage $ MsgMailAllocationRegister (length allocs)}
|
||||||
<br>
|
|
||||||
<a href=@{AllocationR allocationTerm allocationSchool allocationShorthand AShowR}>
|
|
||||||
#{allocationName}
|
|
||||||
|
|
||||||
$maybe until <- registerDeadline
|
$case allocs
|
||||||
<p>
|
$of [Allocation{allocationTerm, allocationSchool, allocationShorthand, allocationName}]
|
||||||
_{SomeMessage $ MsgMailAllocationRegisterDeadline until}
|
<a href=@{AllocationR allocationTerm allocationSchool allocationShorthand AShowR}>
|
||||||
|
_{SomeMessage $ MsgMailAllocationSchoolAndName allocationSchool allocationName}
|
||||||
|
$of _
|
||||||
|
<ul>
|
||||||
|
$forall Allocation{allocationTerm, allocationSchool, allocationShorthand, allocationName} <- allocs
|
||||||
|
<li>
|
||||||
|
<a href=@{AllocationR allocationTerm allocationSchool allocationShorthand AShowR}>
|
||||||
|
_{SomeMessage $ MsgMailAllocationSchoolAndName allocationSchool allocationName}
|
||||||
|
|
||||||
|
$if doRegisterDeadlines
|
||||||
|
$if singleRegisterDeadline
|
||||||
|
$maybe (_, registerDeadline) <- preview _head deadlines
|
||||||
|
$maybe until <- registerDeadline
|
||||||
|
<p>
|
||||||
|
_{SomeMessage $ MsgMailAllocationRegisterDeadline until}
|
||||||
|
$else
|
||||||
|
<p>
|
||||||
|
_{SomeMessage $ MsgMailAllocationRegisterDeadlineMultiple}
|
||||||
|
|
||||||
|
<ul>
|
||||||
|
$forall (Allocation{allocationSchool, allocationName}, registerDeadline) <- deadlines
|
||||||
|
<li>
|
||||||
|
<p .bold>
|
||||||
|
_{SomeMessage $ MsgMailAllocationSchoolAndName allocationSchool allocationName}
|
||||||
|
<p>
|
||||||
|
$maybe until <- registerDeadline
|
||||||
|
_{SomeMessage $ MsgMailAllocationRegisterDeadlineSingle until}
|
||||||
|
$nothing
|
||||||
|
_{SomeMessage MsgMailAllocationRegisterDeadlineSingleNothing}
|
||||||
|
|
||||||
^{ihamletSomeMessage editNotifications}
|
^{ihamletSomeMessage editNotifications}
|
||||||
|
|||||||
@ -9,9 +9,22 @@ $newline never
|
|||||||
font-variant: small-caps;
|
font-variant: small-caps;
|
||||||
font-weight: normal;
|
font-weight: normal;
|
||||||
}
|
}
|
||||||
|
.bold {
|
||||||
|
font-weight: bold;
|
||||||
|
}
|
||||||
<body>
|
<body>
|
||||||
<h1>
|
$case allocs
|
||||||
_{SomeMessage $ MsgMailSubjectAllocationStaffRegister allocationName}
|
$of [Allocation{allocationSchool, allocationName}]
|
||||||
|
<h1>
|
||||||
|
_{SomeMessage $ MsgMailSubjectAllocationStaffRegister allocationSchool allocationName}
|
||||||
|
$of _
|
||||||
|
<h1>
|
||||||
|
_{SomeMessage $ MsgMailAllocationStaffRegisterIntroMultiple (length allocs)}
|
||||||
|
|
||||||
|
<ul>
|
||||||
|
$forall Allocation{allocationName, allocationSchool} <- allocs
|
||||||
|
<li>
|
||||||
|
_{SomeMessage $ MsgMailAllocationSchoolAndName allocationSchool allocationName}
|
||||||
|
|
||||||
<p>
|
<p>
|
||||||
_{SomeMessage MsgMailAllocationStaffRegisterNewCourse}
|
_{SomeMessage MsgMailAllocationStaffRegisterNewCourse}
|
||||||
@ -19,8 +32,26 @@ $newline never
|
|||||||
<a href=@{CourseNewR}>
|
<a href=@{CourseNewR}>
|
||||||
_{SomeMessage MsgMenuCourseNew}
|
_{SomeMessage MsgMenuCourseNew}
|
||||||
|
|
||||||
$maybe until <- registerDeadline
|
$if doRegisterDeadlines
|
||||||
<p>
|
$if singleRegisterDeadline
|
||||||
_{SomeMessage $ MsgMailAllocationStaffRegisterDeadline until}
|
$maybe (_, registerDeadline) <- preview _head deadlines
|
||||||
|
$maybe until <- registerDeadline
|
||||||
|
<p>
|
||||||
|
_{SomeMessage $ MsgMailAllocationStaffRegisterDeadline (length allocs) until}
|
||||||
|
$else
|
||||||
|
<p>
|
||||||
|
_{SomeMessage $ MsgMailAllocationStaffRegisterDeadlineMultiple}
|
||||||
|
|
||||||
|
<ul>
|
||||||
|
$forall (Allocation{allocationSchool, allocationName}, staffRegisterDeadline) <- deadlines
|
||||||
|
<li>
|
||||||
|
<p .bold>
|
||||||
|
_{SomeMessage $ MsgMailAllocationSchoolAndName allocationSchool allocationName}
|
||||||
|
<p>
|
||||||
|
$maybe until <- staffRegisterDeadline
|
||||||
|
_{SomeMessage $ MsgMailAllocationStaffRegisterDeadlineSingle until}
|
||||||
|
$nothing
|
||||||
|
_{SomeMessage MsgMailAllocationStaffRegisterDeadlineSingleNothing}
|
||||||
|
|
||||||
|
|
||||||
^{ihamletSomeMessage editNotifications}
|
^{ihamletSomeMessage editNotifications}
|
||||||
|
|||||||
@ -9,21 +9,49 @@ $newline never
|
|||||||
font-variant: small-caps;
|
font-variant: small-caps;
|
||||||
font-weight: normal;
|
font-weight: normal;
|
||||||
}
|
}
|
||||||
|
.bold {
|
||||||
|
font-weight: bold;
|
||||||
|
}
|
||||||
<body>
|
<body>
|
||||||
<h1>
|
<h1>
|
||||||
_{SomeMessage $ MsgMailSubjectAllocationUnratedApplications allocationName}
|
$case allocations
|
||||||
|
$of [Entity _ Allocation{allocationSchool, allocationName}]
|
||||||
|
_{SomeMessage $ MsgMailSubjectAllocationUnratedApplications allocationSchool allocationName}
|
||||||
|
$of _
|
||||||
|
_{SomeMessage $ MsgMailAllocationUnratedApplicationsIntroMultiple (length allocations)}
|
||||||
|
|
||||||
<p>
|
<p>
|
||||||
_{SomeMessage MsgMailAllocationUnratedApplications}
|
_{SomeMessage $ MsgMailAllocationUnratedApplications (length allocations)}
|
||||||
<ul>
|
<ul>
|
||||||
$forall (tid, ssh, csh, cName, numUnrated) <- courses
|
$forall (Entity _ Allocation{allocationSchool, allocationName}, Entity _ Course{courseTerm, courseSchool, courseShorthand, courseName}, unrated) <- courses
|
||||||
<li>
|
<li>
|
||||||
<a href=@{CourseR tid ssh csh CApplicationsR}>
|
<a href=@{CourseR courseTerm courseSchool courseShorthand CApplicationsR}>
|
||||||
#{cName}
|
#{courseName} #
|
||||||
\ (#{tshow numUnrated})
|
(
|
||||||
|
_{SomeMessage $ MsgMailAllocationSchoolAndName allocationSchool allocationName}, #
|
||||||
|
_{SomeMessage $ MsgMailAllocationUnratedApplicationsCount unrated}
|
||||||
|
)
|
||||||
|
|
||||||
|
$if doDeadlines
|
||||||
|
$if sameDeadlines
|
||||||
|
$maybe (_, allocationDeadline) <- preview _head deadlines
|
||||||
|
$maybe until <- allocationDeadline
|
||||||
|
<p>
|
||||||
|
_{SomeMessage $ MsgMailAllocationAllocationDeadline until}
|
||||||
|
$else
|
||||||
|
<p>
|
||||||
|
_{SomeMessage MsgMailAllocationAllocationDeadlineMultiple}
|
||||||
|
|
||||||
|
<ul>
|
||||||
|
$forall (Allocation{allocationSchool, allocationName}, allocationDeadline) <- deadlines
|
||||||
|
<li>
|
||||||
|
<p .bold>
|
||||||
|
_{SomeMessage $ MsgMailAllocationSchoolAndName allocationSchool allocationName}
|
||||||
|
<p>
|
||||||
|
$maybe until <- allocationDeadline
|
||||||
|
_{SomeMessage $ MsgMailAllocationApplicationsAllocationDeadline until}
|
||||||
|
$nothing
|
||||||
|
_{SomeMessage MsgMailAllocationApplicationsAllocationDeadlineNothing}
|
||||||
|
|
||||||
$maybe until <- allocationDeadline
|
|
||||||
<p>
|
|
||||||
_{SomeMessage $ MsgMailAllocationAllocationDeadline until}
|
|
||||||
|
|
||||||
^{ihamletSomeMessage editNotifications}
|
^{ihamletSomeMessage editNotifications}
|
||||||
|
|||||||
@ -371,6 +371,10 @@ fillDb = do
|
|||||||
void . insert' $ UserFunction jost ifi SchoolLecturer
|
void . insert' $ UserFunction jost ifi SchoolLecturer
|
||||||
void . insert' $ UserFunction svaupel ifi SchoolLecturer
|
void . insert' $ UserFunction svaupel ifi SchoolLecturer
|
||||||
void . insert' $ UserFunction gkleen ifi SchoolAllocation
|
void . insert' $ UserFunction gkleen ifi SchoolAllocation
|
||||||
|
for_ [gkleen, fhamann, jost, maxMuster, svaupel] $ \uid ->
|
||||||
|
void . insert' $ UserSchool uid ifi False
|
||||||
|
for_ [gkleen, tinaTester] $ \uid ->
|
||||||
|
void . insert' $ UserSchool uid mi False
|
||||||
let
|
let
|
||||||
sdBsc = StudyDegreeKey' 82
|
sdBsc = StudyDegreeKey' 82
|
||||||
sdMst = StudyDegreeKey' 88
|
sdMst = StudyDegreeKey' 88
|
||||||
@ -1014,11 +1018,11 @@ fillDb = do
|
|||||||
, allocationDescription = Nothing
|
, allocationDescription = Nothing
|
||||||
, allocationStaffDescription = Nothing
|
, allocationStaffDescription = Nothing
|
||||||
, allocationStaffRegisterFrom = Just now
|
, allocationStaffRegisterFrom = Just now
|
||||||
, allocationStaffRegisterTo = Nothing
|
, allocationStaffRegisterTo = Just $ 300 `addUTCTime` now
|
||||||
, allocationStaffAllocationFrom = Nothing
|
, allocationStaffAllocationFrom = Just $ 300 `addUTCTime` now
|
||||||
, allocationStaffAllocationTo = Nothing
|
, allocationStaffAllocationTo = Just $ 900 `addUTCTime` now
|
||||||
, allocationRegisterFrom = Nothing
|
, allocationRegisterFrom = Just $ 300 `addUTCTime` now
|
||||||
, allocationRegisterTo = Nothing
|
, allocationRegisterTo = Just $ 600 `addUTCTime` now
|
||||||
, allocationRegisterByStaffFrom = Nothing
|
, allocationRegisterByStaffFrom = Nothing
|
||||||
, allocationRegisterByStaffTo = Nothing
|
, allocationRegisterByStaffTo = Nothing
|
||||||
, allocationRegisterByCourse = Nothing
|
, allocationRegisterByCourse = Nothing
|
||||||
@ -1147,12 +1151,12 @@ fillDb = do
|
|||||||
, allocationSchool = ifi
|
, allocationSchool = ifi
|
||||||
, allocationDescription = Nothing
|
, allocationDescription = Nothing
|
||||||
, allocationStaffDescription = Nothing
|
, allocationStaffDescription = Nothing
|
||||||
, allocationStaffRegisterFrom = Nothing
|
, allocationStaffRegisterFrom = Just now
|
||||||
, allocationStaffRegisterTo = Nothing
|
, allocationStaffRegisterTo = Just $ 300 `addUTCTime` now
|
||||||
, allocationStaffAllocationFrom = Nothing
|
, allocationStaffAllocationFrom = Just $ 300 `addUTCTime` now
|
||||||
, allocationStaffAllocationTo = Nothing
|
, allocationStaffAllocationTo = Just $ 900 `addUTCTime` now
|
||||||
, allocationRegisterFrom = Nothing
|
, allocationRegisterFrom = Just $ 300 `addUTCTime` now
|
||||||
, allocationRegisterTo = Just now
|
, allocationRegisterTo = Just $ 600 `addUTCTime` now
|
||||||
, allocationRegisterByStaffFrom = Nothing
|
, allocationRegisterByStaffFrom = Nothing
|
||||||
, allocationRegisterByStaffTo = Nothing
|
, allocationRegisterByStaffTo = Nothing
|
||||||
, allocationRegisterByCourse = Nothing
|
, allocationRegisterByCourse = Nothing
|
||||||
|
|||||||
Reference in New Issue
Block a user