feat(allocations): notification about finished allocation
This commit is contained in:
Gregor Kleen
parent
7a759b192f
commit
93232201f2
@ -900,6 +900,7 @@ NotificationTriggerAllocationAllocation: Ich kann Zentralanmeldung-Bewerbungen f
|
||||
NotificationTriggerAllocationRegister: Ich kann mich bei einer neuen Zentralanmeldung bewerben
|
||||
NotificationTriggerAllocationOutdatedRatings: Zentralanmeldung-Bewerbungen für einen meiner Kurse wurden verändert, nachdem sie bewertet wurden
|
||||
NotificationTriggerAllocationUnratedApplications: Bewertungen zu Zentralanmeldung-Bewerbungen für einen meiner Kurse stehen aus
|
||||
NotificationTriggerAllocationResults: Plätze wurden für eine meiner Zentralanmeldungen verteilt
|
||||
NotificationTriggerExamOfficeExamResults: Ich kann neue Prüfungsergebnisse einsehen
|
||||
NotificationTriggerExamOfficeExamResultsChanged: Prüfungsergebnisse wurden verändert
|
||||
|
||||
@ -911,7 +912,8 @@ NotificationTriggerKindLecturer: Für Dozenten
|
||||
NotificationTriggerKindAdmin: Für Administratoren
|
||||
NotificationTriggerKindExamOffice: Für das Prüfungsamt
|
||||
NotificationTriggerKindEvaluation: Für Vorlesungsumfragen
|
||||
NotificationTriggerKindAllocationStaff: Für Zentralanmeldungen
|
||||
NotificationTriggerKindAllocationStaff: Für Zentralanmeldungen (Dozenten)
|
||||
NotificationTriggerKindAllocationParticipant: Für Zentralanmeldungen
|
||||
|
||||
CorrCreate: Abgaben erstellen
|
||||
UnknownPseudonymWord pseudonymWord@Text: Unbekanntes Pseudonym-Wort "#{pseudonymWord}"
|
||||
@ -1864,4 +1866,11 @@ CourseDeregistrationAllocationLog: Ihr Platz in diesem Kurs stammt aus einer Zen
|
||||
CourseDeregistrationAllocationReason: Grund
|
||||
CourseDeregistrationAllocationReasonTip: Der angegebene Grund wird permanent im System hinterlegt und ist i.A. einziger Anhaltspunkt zur Schlichtung etwaiger Konflikte
|
||||
CourseDeregistrationAllocationShouldLog: Selbstverschuldet
|
||||
CourseDeregistrationAllocationShouldLogTip: Falls der Platz des Studierenden, der abgemeldet wird, aus einer Zentralanmeldung stammt, ist vorgesehen einen permanenten Eintrag im System zu speichern, der den Studierenden u.U. bei zukünftigen Zentralanmeldungen benachteiligt. Als Kursverwalter haben Sie die Möglichkeit dies zu unterbinden, wenn der Studierende gute Gründe vorweisen kann, warum seine Abmeldung nicht selbstverschuldet ist.
|
||||
CourseDeregistrationAllocationShouldLogTip: Falls der Platz des Studierenden, der abgemeldet wird, aus einer Zentralanmeldung stammt, ist vorgesehen einen permanenten Eintrag im System zu speichern, der den Studierenden u.U. bei zukünftigen Zentralanmeldungen benachteiligt. Als Kursverwalter haben Sie die Möglichkeit dies zu unterbinden, wenn der Studierende gute Gründe vorweisen kann, warum seine Abmeldung nicht selbstverschuldet ist.
|
||||
|
||||
MailSubjectAllocationResults allocation@AllocationName: Plätze für Zentralanmeldung „#{allocation}“ wurden verteilt
|
||||
AllocationResultsLecturer: Es wurden Plätze zugewiesen, wie folgt:
|
||||
AllocationResultLecturer csh@CourseShorthand count@Int64: #{count} Teilnehmer für #{csh}
|
||||
AllocationResultsStudent: Sie haben Plätze erhalten in:
|
||||
AllocationNoResultsStudent: Sie haben leider keine Plätze erhalten.
|
||||
AllocationResultStudent csh@CourseShorthand: Sie haben einen Platz in #{csh} erhalten.
|
||||
@ -49,6 +49,7 @@ data NotificationTriggerKind
|
||||
| NTKExamParticipant
|
||||
| NTKCorrector
|
||||
| NTKAllocationStaff
|
||||
| NTKAllocationParticipant
|
||||
| NTKFunctionary SchoolFunction
|
||||
deriving (Eq, Ord, Generic, Typeable)
|
||||
deriveFinite ''NotificationTriggerKind
|
||||
@ -60,6 +61,7 @@ instance RenderMessage UniWorX NotificationTriggerKind where
|
||||
NTKExamParticipant -> mr MsgNotificationTriggerKindExamParticipant
|
||||
NTKCorrector -> mr MsgNotificationTriggerKindCorrector
|
||||
NTKAllocationStaff -> mr MsgNotificationTriggerKindAllocationStaff
|
||||
NTKAllocationParticipant -> mr MsgNotificationTriggerKindAllocationParticipant
|
||||
NTKFunctionary SchoolAdmin -> mr MsgNotificationTriggerKindAdmin
|
||||
NTKFunctionary SchoolLecturer -> mr MsgNotificationTriggerKindLecturer
|
||||
NTKFunctionary SchoolExamOffice -> mr MsgNotificationTriggerKindExamOffice
|
||||
@ -185,6 +187,7 @@ notificationForm template = wFormToAForm $ do
|
||||
NTAllocationRegister -> Just NTKAll
|
||||
NTAllocationOutdatedRatings -> Just NTKAllocationStaff
|
||||
NTAllocationUnratedApplications -> Just NTKAllocationStaff
|
||||
NTAllocationResults -> Just NTKAllocationParticipant
|
||||
NTExamOfficeExamResults -> Just $ NTKFunctionary SchoolExamOffice
|
||||
NTExamOfficeExamResultsChanged -> Just $ NTKFunctionary SchoolExamOffice
|
||||
-- _other -> Nothing
|
||||
|
||||
@ -336,5 +336,17 @@ determineCrontab = execWriterT $ do
|
||||
}
|
||||
_other
|
||||
-> return ()
|
||||
lastResult <- fmap (E.unValue <=< listToMaybe) . lift . E.select . E.from $ \participant -> do
|
||||
E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
|
||||
return . E.max_ $ participant E.^. CourseParticipantRegistration
|
||||
whenIsJust lastResult $ \lastResult' ->
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobQueueNotification NotificationAllocationResults{..})
|
||||
Cron
|
||||
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay lastResult'
|
||||
, cronRepeat = CronRepeatNever
|
||||
, cronRateLimit = appNotificationRateLimit
|
||||
, cronNotAfter = Left appNotificationExpiration
|
||||
}
|
||||
|
||||
runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ allocationJobs
|
||||
|
||||
@ -198,6 +198,18 @@ determineNotificationCandidates NotificationExamOfficeExamResultsChanged{..} =
|
||||
E.where_ $ examResult E.^. ExamResultId `E.in_` E.valList (Set.toList nExamResults)
|
||||
E.where_ $ examOfficeExamResultAuth (user E.^. UserId) examResult
|
||||
return user
|
||||
determineNotificationCandidates NotificationAllocationResults{..} =
|
||||
E.select . 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
|
||||
E.where_ $ isStudent E.||. isLecturer
|
||||
|
||||
return user
|
||||
|
||||
|
||||
classifyNotification :: Notification -> DB NotificationTrigger
|
||||
@ -224,3 +236,4 @@ classifyNotification NotificationAllocationOutdatedRatings{} = return NTAll
|
||||
classifyNotification NotificationAllocationUnratedApplications{} = return NTAllocationUnratedApplications
|
||||
classifyNotification NotificationExamOfficeExamResults{} = return NTExamOfficeExamResults
|
||||
classifyNotification NotificationExamOfficeExamResultsChanged{} = return NTExamOfficeExamResultsChanged
|
||||
classifyNotification NotificationAllocationResults{} = return NTAllocationResults
|
||||
|
||||
@ -6,6 +6,7 @@ module Jobs.Handler.SendNotification.Allocation
|
||||
, dispatchNotificationAllocationAllocation
|
||||
, dispatchNotificationAllocationUnratedApplications
|
||||
, dispatchNotificationAllocationOutdatedRatings
|
||||
, dispatchNotificationAllocationResults
|
||||
) where
|
||||
|
||||
import Import
|
||||
@ -157,3 +158,41 @@ dispatchNotificationAllocationOutdatedRatings nAllocation jRecipient = do
|
||||
addAlternatives $
|
||||
providePreferredAlternative $(ihamletFile "templates/mail/allocationOutdatedRatings.hamlet")
|
||||
|
||||
dispatchNotificationAllocationResults :: AllocationId -> UserId -> Handler ()
|
||||
dispatchNotificationAllocationResults nAllocation jRecipient = userMailT jRecipient $ do
|
||||
(Allocation{..}, lecturerResults, participantResults) <- liftHandler . runDB $ do
|
||||
allocation <- getJust nAllocation
|
||||
|
||||
lecturerResults' <- E.select . E.from $ \(lecturer `E.InnerJoin` course) -> do
|
||||
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
|
||||
E.where_ $ lecturer E.^. LecturerUser E.==. E.val jRecipient
|
||||
E.&&. E.exists (E.from $ \allocationCourse ->
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
|
||||
)
|
||||
let participantCount = E.sub_select . E.from $ \participant -> do
|
||||
E.where_ $ participant E.^. CourseParticipantCourse E.==. lecturer E.^. LecturerCourse
|
||||
E.&&. participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
|
||||
return E.countRows :: E.SqlQuery (E.SqlExpr (E.Value Int64))
|
||||
return (course, participantCount)
|
||||
let lecturerResults = flip map lecturerResults' $ \(Entity _ Course{..}, E.Value partCount) -> SomeMessage $ MsgAllocationResultLecturer courseShorthand partCount
|
||||
|
||||
doParticipantResults <- E.selectExists . E.from $ \application ->
|
||||
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (E.val nAllocation)
|
||||
participantResults' <- E.select . E.from $ \(participant `E.InnerJoin` course) -> do
|
||||
E.on $ participant E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
||||
E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
|
||||
return course
|
||||
let participantResults = case participantResults' of
|
||||
[] | doParticipantResults -> Just []
|
||||
| otherwise -> Nothing
|
||||
cs -> Just $ map (courseShorthand . entityVal) cs
|
||||
|
||||
return (allocation, lecturerResults, participantResults)
|
||||
|
||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||
setSubjectI $ MsgMailSubjectAllocationResults allocationName
|
||||
editNotifications <- mkEditNotifications jRecipient
|
||||
|
||||
addAlternatives $
|
||||
providePreferredAlternative $(ihamletFile "templates/mail/allocationResults.hamlet")
|
||||
|
||||
@ -87,6 +87,7 @@ data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
|
||||
| NotificationAllocationOutdatedRatings { nAllocation :: AllocationId }
|
||||
| NotificationExamOfficeExamResults { nExam :: ExamId }
|
||||
| NotificationExamOfficeExamResultsChanged { nExamResults :: Set ExamResultId }
|
||||
| NotificationAllocationResults { nAllocation :: AllocationId }
|
||||
deriving (Eq, Ord, Show, Read, Generic, Typeable)
|
||||
|
||||
instance Hashable Job
|
||||
|
||||
@ -40,6 +40,7 @@ data NotificationTrigger
|
||||
| NTAllocationRegister
|
||||
| NTAllocationOutdatedRatings
|
||||
| NTAllocationUnratedApplications
|
||||
| NTAllocationResults
|
||||
| NTExamOfficeExamResults
|
||||
| NTExamOfficeExamResultsChanged
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
|
||||
36
templates/mail/allocationResults.hamlet
Normal file
36
templates/mail/allocationResults.hamlet
Normal file
@ -0,0 +1,36 @@
|
||||
$newline never
|
||||
\<!doctype html>
|
||||
<html>
|
||||
<head>
|
||||
<meta charset="UTF-8">
|
||||
<style>
|
||||
h1 {
|
||||
font-size: 1.25em;
|
||||
font-variant: small-caps;
|
||||
font-weight: normal;
|
||||
}
|
||||
<body>
|
||||
<h1>
|
||||
_{SomeMessage $ MsgMailSubjectAllocationResults allocationName}
|
||||
|
||||
$if not (null lecturerResults)
|
||||
<p>
|
||||
_{SomeMessage MsgAllocationResultsLecturer}
|
||||
<ul>
|
||||
$forall msg <- lecturerResults
|
||||
<li>_{msg}
|
||||
|
||||
$maybe pResults <- participantResults
|
||||
$case pResults
|
||||
$of []
|
||||
<p>_{SomeMessage MsgAllocationNoResultsStudent}
|
||||
$of [csh]
|
||||
<p>_{SomeMessage $ MsgAllocationResultStudent csh}
|
||||
$of cshs
|
||||
<p>
|
||||
_{SomeMessage MsgAllocationResultsStudent}
|
||||
<ul>
|
||||
$forall csh <- cshs
|
||||
<li>#{csh}
|
||||
|
||||
^{ihamletSomeMessage editNotifications}
|
||||
Loading…
Reference in New Issue
Block a user