chore(lme): fix #58 by wording renewal letter
This commit is contained in:
parent
9bd1076a9c
commit
1f485affb4
@ -62,10 +62,38 @@ dispatchJobLmsEnqueue qid = JobHandlerAtomic act
|
||||
$logInfoS "LMS" $ "Notifying about exipiring qualification " <> qshort
|
||||
now <- liftIO getCurrentTime
|
||||
case qualificationRefreshWithin quali of
|
||||
Nothing -> return () -- no automatic scheduling for this qid
|
||||
Nothing -> return () -- TODO: no renewal period, no reminders currenty
|
||||
(Just renewalPeriod) -> do
|
||||
let now_day = utctDay now
|
||||
renewalDate = addGregorianDurationClip renewalPeriod now_day
|
||||
renewalDate = addGregorianDurationClip renewalPeriod now_day
|
||||
sendReminders remindPeriod = do
|
||||
let remindDate = addGregorianDurationClip remindPeriod now_day
|
||||
reminders <- E.select $ do -- TODO: refactor to remove some redundancies with later query
|
||||
(luser :& quser) <- E.from $ E.table @LmsUser `E.innerJoin` E.table @QualificationUser
|
||||
`E.on` (\(luser :& quser) -> luser E.^. LmsUserQualification E.==. quser E.^. QualificationUserQualification
|
||||
E.&&. luser E.^. LmsUserUser E.==. quser E.^. QualificationUserUser
|
||||
)
|
||||
E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid
|
||||
E.&&. quser E.^. QualificationUserScheduleRenewal
|
||||
E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val now_day
|
||||
E.&&. quser E.^. QualificationUserValidUntil E.<=. E.val remindDate
|
||||
E.&&. E.isNothing (quser E.^. QualificationUserBlockedDue)
|
||||
E.&&. E.isNothing (luser E.^. LmsUserEnded)
|
||||
E.&&. E.isNothing (luser E.^. LmsUserStatus)
|
||||
E.&&. E.isJust (luser E.^. LmsUserNotified)
|
||||
-- E.&&. ((day_ (luser E.^. LmsUserNotified) E.+. E.interval remindPeriod) E.<. quser E.^. QualificationUserValidUntil) -- not sure whether may throw runtime errors, so we check in Haskell-Land instead
|
||||
return (luser, quser E.^. QualificationUserValidUntil)
|
||||
forM_ reminders $ \case
|
||||
(Entity _ (LmsUser{lmsUserUser=luser, lmsUserNotified=Just lnotified}), E.Value quValidUntil)
|
||||
| addGregorianDurationClip remindPeriod (utctDay lnotified) < quValidUntil ->
|
||||
queueDBJob JobSendNotification
|
||||
{ jRecipient = luser
|
||||
, jNotification = NotificationQualificationRenewal { nQualification = qid, nReminder = True }
|
||||
}
|
||||
_ -> return ()
|
||||
-- send second reminders first, before enqueing even more
|
||||
ifMaybeM (qualificationRefreshReminder quali) () sendReminders
|
||||
|
||||
renewalUsers <- E.select $ do
|
||||
quser <- E.from $ E.table @QualificationUser
|
||||
E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid
|
||||
@ -277,37 +305,7 @@ dispatchJobLmsUserlist qid = JobHandlerAtomic act
|
||||
where
|
||||
act :: YesodJobDB UniWorX ()
|
||||
act = do
|
||||
now <- liftIO getCurrentTime
|
||||
-- send reminders first -- TODO: move to dispatchJobLmsEnqueueUser
|
||||
let sendReminders remindPeriod = do
|
||||
let now_day = utctDay now
|
||||
remindDate = addGregorianDurationClip remindPeriod now_day
|
||||
reminders <- E.select $ do
|
||||
(luser :& quser) <- E.from $ E.table @LmsUser `E.innerJoin` E.table @QualificationUser
|
||||
`E.on` (\(luser :& quser) -> luser E.^. LmsUserQualification E.==. quser E.^. QualificationUserQualification
|
||||
E.&&. luser E.^. LmsUserUser E.==. quser E.^. QualificationUserUser
|
||||
)
|
||||
E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid
|
||||
E.&&. quser E.^. QualificationUserScheduleRenewal
|
||||
E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val now_day
|
||||
E.&&. quser E.^. QualificationUserValidUntil E.<=. E.val remindDate
|
||||
E.&&. E.isNothing (quser E.^. QualificationUserBlockedDue)
|
||||
E.&&. E.isNothing (luser E.^. LmsUserEnded)
|
||||
E.&&. E.isNothing (luser E.^. LmsUserStatus)
|
||||
E.&&. E.isJust (luser E.^. LmsUserNotified)
|
||||
-- E.&&. ((day_ (luser E.^. LmsUserNotified) E.+. E.interval remindPeriod) E.<. quser E.^. QualificationUserValidUntil) -- not sure whether may throw runtime errors, so we check in Haskell-Land instead
|
||||
return (luser, quser E.^. QualificationUserValidUntil)
|
||||
forM_ reminders $ \case
|
||||
(Entity _ (LmsUser{lmsUserUser=luser, lmsUserNotified=Just lnotified}), E.Value quValidUntil)
|
||||
| addGregorianDurationClip remindPeriod (utctDay lnotified) < quValidUntil ->
|
||||
queueDBJob JobSendNotification
|
||||
{ jRecipient = luser
|
||||
, jNotification = NotificationQualificationRenewal { nQualification = qid, nReminder = True }
|
||||
}
|
||||
_ -> return ()
|
||||
maybeM (return ()) sendReminders ((>>= view _qualificationRefreshReminder) <$> get qid)
|
||||
-- now process actual results
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
-- result :: [(Entity LmsUser, Entity LmsUserlist)]
|
||||
results <- E.select $ do
|
||||
(luser :& lulist) <- E.from $
|
||||
|
||||
@ -67,6 +67,9 @@ instance MDLetter LetterRenewQualificationF where
|
||||
, toMeta "de-opening" ("Sehr geehrte Damen und Herren,"::Text)
|
||||
, toMeta "en-opening" ("Dear Sir or Madam,"::Text)
|
||||
] <>
|
||||
guardMonoid isReminder
|
||||
[ toMeta "reminder" ("reminder"::Text)
|
||||
] <>
|
||||
[ toMeta "lang" lang
|
||||
, toMeta "login" lmsIdent
|
||||
, toMeta "pin" lmsPin
|
||||
@ -75,11 +78,12 @@ instance MDLetter LetterRenewQualificationF where
|
||||
, mbMeta "validduration" (show <$> qualDuration)
|
||||
, toMeta "url-text" lmsUrl
|
||||
, toMeta "url" lmsUrlLogin
|
||||
|
||||
]
|
||||
|
||||
getPJId LetterRenewQualificationF{..} =
|
||||
PrintJobIdentification
|
||||
{ pjiName = "Renewal"
|
||||
{ pjiName = bool "Renewal Reminder" "Renewal" isReminder
|
||||
, pjiApcAcknowledge = "lms-" <> getLmsIdent lmsLogin
|
||||
, pjiRecipient = Nothing -- to be filled later
|
||||
, pjiSender = Nothing
|
||||
|
||||
@ -54,13 +54,19 @@ $endfor$
|
||||
$if(is-de)$
|
||||
|
||||
<!-- deutsche Version des Briefes -->
|
||||
die Gültigkeit
|
||||
$if(reminder)$
|
||||
dies ist die letzte **Erinnerung**: bis $date$ wurde das E-Learning noch nicht abgeschlossen.
|
||||
Bitte schnellstmöglich durchführen, da ansonsten die Qualifikation
|
||||
nach dem Ablauftag automatisch entzogen wird!
|
||||
$else$
|
||||
die Gültigkeit
|
||||
$if(supervisor)$
|
||||
des Vorfeldführerscheins von $examinee$
|
||||
$else$
|
||||
Ihres Vorfeldführerscheins
|
||||
$endif$
|
||||
läuft bald ab.
|
||||
$endif$
|
||||
Durch die erfolgreiche Teilnahme an einem E-Learning kann die Gültigkeit
|
||||
$if(validduration)$
|
||||
um $validduration$ Monate
|
||||
@ -96,12 +102,17 @@ Bei Fragen können Sie sich gerne an das Team der Fahrerausbildung wenden.
|
||||
$else$
|
||||
|
||||
<!-- englische Version des Briefes -->
|
||||
$if(reminder)$
|
||||
this is a last **reminder**: as of $date$, the below detailed e-learning has not yet been completed.
|
||||
The qualification will expire automatically, if the e-learning is not concluded!
|
||||
$else$
|
||||
$if(supervisor)$
|
||||
the apron diving license of $examinee$
|
||||
$else$
|
||||
your apron diving license
|
||||
$endif$
|
||||
is about to expire soon.
|
||||
is about to expire soon.
|
||||
$endif$
|
||||
The validity will be extended
|
||||
$if(validduration)$
|
||||
by $validduration$ months
|
||||
|
||||
Loading…
Reference in New Issue
Block a user