205 lines
10 KiB
Haskell
205 lines
10 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -- ihamletFile discards do results
|
|
|
|
module Jobs.Handler.SendNotification.Allocation
|
|
( dispatchNotificationAllocationStaffRegister
|
|
, dispatchNotificationAllocationRegister
|
|
, dispatchNotificationAllocationAllocation
|
|
, dispatchNotificationAllocationUnratedApplications
|
|
, dispatchNotificationAllocationOutdatedRatings
|
|
, dispatchNotificationAllocationResults
|
|
) where
|
|
|
|
import Import
|
|
|
|
import Handler.Utils
|
|
import Jobs.Handler.SendNotification.Utils
|
|
|
|
import Text.Hamlet
|
|
|
|
import qualified Database.Esqueleto as E
|
|
import qualified Database.Esqueleto.Utils as E
|
|
|
|
|
|
dispatchNotificationAllocationStaffRegister :: AllocationId -> UserId -> Handler ()
|
|
dispatchNotificationAllocationStaffRegister nAllocation jRecipient = userMailT jRecipient $ do
|
|
Allocation{..} <- liftHandler . runDB $ getJust nAllocation
|
|
|
|
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
|
setSubjectI $ MsgMailSubjectAllocationStaffRegister allocationName
|
|
editNotifications <- mkEditNotifications jRecipient
|
|
registerDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffRegisterTo
|
|
addAlternatives $
|
|
providePreferredAlternative $(ihamletFile "templates/mail/allocationStaffRegister.hamlet")
|
|
|
|
dispatchNotificationAllocationRegister :: AllocationId -> UserId -> Handler ()
|
|
dispatchNotificationAllocationRegister nAllocation jRecipient = userMailT jRecipient $ do
|
|
Allocation{..} <- liftHandler . runDB $ getJust nAllocation
|
|
|
|
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
|
setSubjectI $ MsgMailSubjectAllocationRegister allocationName
|
|
editNotifications <- mkEditNotifications jRecipient
|
|
registerDeadline <- traverse (formatTime SelFormatDateTime) allocationRegisterTo
|
|
addAlternatives $
|
|
providePreferredAlternative $(ihamletFile "templates/mail/allocationRegister.hamlet")
|
|
|
|
dispatchNotificationAllocationAllocation :: AllocationId -> UserId -> Handler ()
|
|
dispatchNotificationAllocationAllocation 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
|
|
return ( course E.^. CourseTerm
|
|
, course E.^. CourseSchool
|
|
, course E.^. CourseShorthand
|
|
, course E.^. CourseName
|
|
)
|
|
let courses' = courses
|
|
& over (traverse . _1) E.unValue
|
|
& over (traverse . _2) E.unValue
|
|
& over (traverse . _3) E.unValue
|
|
& over (traverse . _4) E.unValue
|
|
return (allocation, courses')
|
|
|
|
unless (null courses) . userMailT jRecipient $ do
|
|
now <- liftIO getCurrentTime
|
|
|
|
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
|
setSubjectI $ MsgMailSubjectAllocationAllocation allocationName
|
|
editNotifications <- mkEditNotifications jRecipient
|
|
allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
|
|
registerDeadline <- traverse (formatTime SelFormatDateTime) $ assertM (> now) allocationRegisterTo
|
|
addAlternatives $
|
|
providePreferredAlternative $(ihamletFile "templates/mail/allocationAllocation.hamlet")
|
|
|
|
dispatchNotificationAllocationUnratedApplications :: AllocationId -> UserId -> Handler ()
|
|
dispatchNotificationAllocationUnratedApplications 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
|
|
unratedAppCount :: E.SqlExpr (E.Value Natural)
|
|
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
|
|
, course E.^. CourseSchool
|
|
, course E.^. CourseShorthand
|
|
, course E.^. CourseName
|
|
, unratedAppCount
|
|
)
|
|
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 $ MsgMailSubjectAllocationUnratedApplications allocationName
|
|
editNotifications <- mkEditNotifications jRecipient
|
|
allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
|
|
addAlternatives $
|
|
providePreferredAlternative $(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
|
|
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 allocatedCount :: E.SqlExpr (E.Value Int64)
|
|
allocatedCount = E.subSelectCount . E.from $ \participant ->
|
|
E.where_ $ participant E.^. CourseParticipantCourse E.==. lecturer E.^. LecturerCourse
|
|
E.&&. participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
|
|
let participantCount :: E.SqlExpr (E.Value Int64)
|
|
participantCount = E.subSelectCount . E.from $ \participant ->
|
|
E.where_ $ participant E.^. CourseParticipantCourse E.==. lecturer E.^. LecturerCourse
|
|
return (course, allocatedCount, participantCount)
|
|
let lecturerResults = flip map lecturerResults' $ \(Entity _ Course{..}, E.Value allocCount, E.Value partCount) -> SomeMessage $ if
|
|
| allocCount == partCount -> MsgAllocationResultLecturerAll courseShorthand allocCount
|
|
| allocCount == 0 -> MsgAllocationResultLecturerNone courseShorthand
|
|
| otherwise -> MsgAllocationResultLecturer courseShorthand allocCount partCount
|
|
|
|
doParticipantResults <- E.selectExists . E.from $ \application ->
|
|
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (E.val nAllocation)
|
|
E.&&. application E.^. CourseApplicationUser E.==. E.val jRecipient
|
|
participantResults' <- E.select . E.from $ \(participant `E.InnerJoin` course) -> do
|
|
E.on $ participant E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
|
E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
|
|
E.&&. participant E.^. CourseParticipantUser E.==. E.val jRecipient
|
|
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")
|