160 lines
7.5 KiB
Haskell
160 lines
7.5 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -- ihamletFile discards do results
|
|
|
|
module Jobs.Handler.SendNotification.Allocation
|
|
( dispatchNotificationAllocationStaffRegister
|
|
, dispatchNotificationAllocationRegister
|
|
, dispatchNotificationAllocationAllocation
|
|
, dispatchNotificationAllocationUnratedApplications
|
|
, dispatchNotificationAllocationOutdatedRatings
|
|
) 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{..} <- liftHandlerT . 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{..} <- liftHandlerT . 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) <- liftHandlerT . 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) <- liftHandlerT . 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.sub_select . E.from $ \application -> do
|
|
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 E.countRows
|
|
|
|
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) <- liftHandlerT . 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.sub_select . E.from $ \application -> do
|
|
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 E.countRows
|
|
|
|
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")
|
|
|