This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Jobs/Handler/SendNotification/SubmissionRated.hs
Gregor Kleen a6390eccbd fix(submissions): take care when to display corrections
Also cleanup usage of Utils via hlint
2021-03-18 23:12:36 +01:00

48 lines
2.0 KiB
Haskell

{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -- ihamletFile discards do results
module Jobs.Handler.SendNotification.SubmissionRated
( dispatchNotificationSubmissionRated
) where
import Import
import Handler.Utils
import Jobs.Handler.SendNotification.Utils
import Text.Hamlet
import qualified Data.CaseInsensitive as CI
dispatchNotificationSubmissionRated :: SubmissionId -> UserId -> Handler ()
dispatchNotificationSubmissionRated nSubmission jRecipient = maybeT_ $ do
(Course{..}, Sheet{..}, Submission{..}, corrector, sheetTypeDesc, hasAccess, csid) <- lift . runDB $ do
submission@Submission{submissionRatingBy} <- getJust nSubmission
sheet@Sheet{sheetName} <- belongsToJust submissionSheet submission
course@Course{..} <- belongsToJust sheetCourse sheet
corrector <- traverse getJust submissionRatingBy
sheetTypeDesc <- sheetTypeDescription (sheetCourse sheet) (sheetType sheet)
csid <- encrypt nSubmission
hasAccess <- is _Authorized <$> evalAccessForDB (Just jRecipient) (CSubmissionR courseTerm courseSchool courseShorthand sheetName csid CorrectionR) False
return (course, sheet, submission, corrector, sheetTypeDesc, hasAccess, csid)
guard hasAccess
lift . userMailT jRecipient $ do
whenIsJust corrector $ \corrector' ->
addMailHeader "Reply-To" . renderAddress $ userAddressFrom corrector'
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI $ MsgMailSubjectSubmissionRated courseShorthand
MsgRenderer mr <- getMailMsgRenderer
let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm
submissionRatingTime' <- traverse (formatTimeMail SelFormatDateTime) submissionRatingTime
let tid = courseTerm
ssh = courseSchool
csh = courseShorthand
shn = sheetName
editNotifications <- mkEditNotifications jRecipient
addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/submissionRated.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX))