chore(lme): fix #58 by wording renewal letter

src/Jobs/Handler/LMS.hs

@@ -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        
+      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
-
       -- result :: [(Entity LmsUser, Entity LmsUserlist)]
       results <- E.select $ do
         (luser :& lulist) <- E.from $

src/Utils/Print/RenewQualification.hs

@@ -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

templates/letter/fraport_renewal.md

@@ -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