Merge branch 'fradrive/newletter'

messages/uniworx/categories/admin/de-de-formal.msg

@@ -126,6 +126,7 @@ AdminProblemSolved: Erledigt
 AdminProblemSolver: Bearbeitet von
 AdminProblemCreated: Erkannt
 AdminProblemInfo: Problembeschreibung
+AdminProblemInfoTooltip: Nur Teile der folgenden englische Begriffe sind derzeit möglich: new-company, supervisor-new-company, supervisor-left-company, superior-change, newly-unsupervised und unknown
 AdminProblemsSolved n@Int: #{pluralDEeN n "Admin Problem"} als erledigt markiert
 AdminProblemsReopened n@Int: #{pluralDEeN n "Admin Problem"} erneut eröffnet
 AdminProblemNewCompany: Neue Firma über AVS automatisch erstellt; prüfen und ggf. Standardansprechpartner eintragen

messages/uniworx/categories/admin/en-eu.msg

@@ -126,6 +126,7 @@ AdminProblemSolved: Done
 AdminProblemSolver: Solved by
 AdminProblemCreated: Recognized
 AdminProblemInfo: Problem
+AdminProblemInfoTooltip: Only parts of the following keys currently work here: new-company, supervisor-new-company, supervisor-left-company, superior-change, newly-unsupervised und unknown
 AdminProblemsSolved n: #{pluralENsN n "admin problem"} marked as solved
 AdminProblemsReopened n: #{pluralENsN n "admin problem"} reopened
 AdminProblemNewCompany: New company from AVS; verify and add default supervisors

messages/uniworx/categories/qualification/de-de-formal.msg

@@ -14,6 +14,7 @@ QualificationRefreshWithinTooltip: Optionaler Zeitraum vor Ablauf für automatis
 QualificationRefreshReminder: 2. Erinnerung
 QualificationRefreshReminderTooltip: Optionaler Zeitraum vor Ablauf zur Versendung einer zweiten Erinnerung per Brief oder Email mit identischen Zugangsdaten, sofern in diesem Zeitraum vor Ablauf noch keine Ablaufbenachrichtigung versendet wurde.
 QualificationElearningStart: Wird das E‑Learning automatisch gestartet?
+QualificationElearningRenew: Verlängert ein erfolgreiches E‑Learning die Qualifikation automatisch um die reguläre Gültigkeitsdauer?
 QualificationExpiryNotification: Ungültigkeitsbenachrichtigung?
 QualificationExpiryNotificationTooltip: Nutzer werden benachrichtigt, wenn die Qualifikation ungültig wird, sofern der jeweilige Nutzer in seinen Benutzereinstellungen diese Art Benachrichtigung aktiviert hat.
 TableQualificationCountActive: Aktive
@@ -47,11 +48,12 @@ QualificationExpired: Ungültig seit
 LmsUser: Inhaber
 LmsURL: Link E‑Learning
 TableLmsEmail: E‑Mail
-TableLmsIdent: E-Learning Benutzer
+TableLmsIdent: E‑Learning Benutzer
 TableLmsElearning: E‑Learning
+TableLmsElearningRenews: Automatische Verlängerung
 TableLmsPin: E‑Learning Passwort
-TableLmsResetPin: E-Learning Passwort zurücksetzen?
+TableLmsResetPin: E‑Learning Passwort zurücksetzen?
-TableLmsDatePin: E-Learning Passwort erstellt
+TableLmsDatePin: E‑Learning Passwort erstellt
 TableLmsDate: Datum
 TableLmsDelete: Löschen?
 TableLmsStaff: Interner Mitarbeiter?
@@ -89,7 +91,8 @@ LmsReportInsert: Neues LMS Ereignis
 LmsReportUpdate: LMS Ereignis Aktualisierung
 LmsReportCsvExceptionDuplicatedKey: CSV-Import LmsReport fand uneindeutigen Schlüssel
 LmsDirectUpload: Direkter Upload für automatisierte Systeme
-LmsErrorNoRefreshElearning: Fehler: E‑Learning wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde.
+LmsErrorNoRefreshElearning: Fehler: E‑Learning wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde!
+LmsErrorNoRenewElearning: Fehler: Erfoglreiches E‑Learning verlängert die Qualifikation nicht automatisch, da die Gültigkeitsdauer nicht festgelegt wurde!
 MailSubjectQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst erneuert werden
 MailSubjectQualificationExpiry qname@Text: Qualifikation #{qname} läuft demnächst ab
 MailSubjectQualificationExpired qname@Text: Qualifikation #{qname} ist ab sofort ungültig

messages/uniworx/categories/qualification/en-eu.msg

@@ -14,6 +14,7 @@ QualificationRefreshWithinTooltip: Optional period before expiry to start e‑le
 QualificationRefreshReminder: 2. Reminder
 QualificationRefreshReminderTooltip: Optional period before expiry to send a second notification by post or email once more, provided that no renewal notification was sent in this period before expiry.
 QualificationElearningStart: Is e‑learning automatically started?
+QualificationElearningRenew: Does successful e‑learning automatically extend a qualification by the default validity period?
 QualificationExpiryNotification: Invalidity notification?
 QualificationExpiryNotificationTooltip: Qualification holder are notfied upon invalidity, provided they have activated such notification in their user settings.
 TableQualificationCountActive: Active
@@ -50,6 +51,7 @@ TableLmsEmail: Email
 TableLmsIdent: E‑learning user
 TableLmsPin: E‑learning password
 TableLmsElearning: E‑learning
+TableLmsElearningRenews: Automatic renewal
 TableLmsResetPin: Reset E‑learning password?
 TableLmsDatePin: E‑learning password created
 TableLmsDate: Date
@@ -89,7 +91,8 @@ LmsReportInsert: New LMS event
 LmsReportUpdate: Update of LMS event
 LmsReportCsvExceptionDuplicatedKey: CSV Import LmsReport with ambiguous key
 LmsDirectUpload: Direct upload for automated systems
-LmsErrorNoRefreshElearning: Error: E‑learning will not be started automatically due to refresh-within time period not being set.
+LmsErrorNoRefreshElearning: Error: E‑learning will not be started automatically due to refresh-within time period not being set!
+LmsErrorNoRenewElearning: Error: E‑learning will not automatically extend validity due to validity duration not being set!
 MailSubjectQualificationRenewal qname: Qualification #{qname} must be renewed shortly
 MailSubjectQualificationExpiry qname: Qualification #{qname} expires soon
 MailSubjectQualificationExpired qname: Qualification #{qname} is no longer valid

models/lms.model

@@ -13,7 +13,7 @@ Qualification
   refreshWithin       CalendarDiffDays Maybe    -- notify users about renewal within this number of month/days before expiry; to be used with addGregorianDurationClip
   refreshReminder     CalendarDiffDays Maybe    -- send a second notification about renewal within this number of month/days before expiry
   elearningStart      Bool                      -- automatically schedule e-refresher
-  -- elearningOnly       Bool                   -- successful E-learing automatically increases validity. NO!  
+  elearningRenews     Bool default=true         -- successful E-learing automatically increases validity automatically by validDuration
   expiryNotification  Bool default=true         -- should expiryNotification be generated for this qualification?
   avsLicence          AvsLicence Maybe          -- if set, valid QualificationUsers are synchronized to AVS as a driving licence
   sapId               Text Maybe                -- if set, valid QualificationUsers with userCompanyPersonalNumber are transmitted via SAP interface under this id

src/Audit/Types.hs

@@ -261,6 +261,7 @@ derivePersistFieldJSON ''Transaction
 -- Datatype for raising admin awareness to certain problems
 -- Database stores generic Value in table ProblemLog, such that changes do not disturb old entries
 -- Note that there is no RenderMessage instance, instead see @Handler.Admin.adminProblemCell dealing with special cases instead
+-- Note: Adjust MsgAdminProblemInfoTooltip as well
 data AdminProblem
   = AdminProblemNewCompany                                      -- new company was noticed, presumably without supervisors
     { adminProblemCompany           :: CompanyId

src/Handler/Admin.hs

@@ -339,10 +339,18 @@ mkProblemLogTable = over _1 postprocess <$> dbTable validator DBTable{..}
       , single ("solver", sortUserNameBareM querySolver)
       ]
     dbtFilter = mconcat
-      [ single ("solved" , FilterColumn . E.mkExactFilterLast $ views (to queryProblem) (E.isJust . (E.^. ProblemLogSolved)))
+      [ single ("user"    , FilterColumn . E.mkContainsFilterWithCommaPlus Just $ views (to queryUser)   (E.?. UserDisplayName))
+      , single ("solver"  , FilterColumn . E.mkContainsFilterWithCommaPlus Just $ views (to querySolver) (E.?. UserDisplayName))
+      , single ("problem" , FilterColumn . E.mkContainsFilter  $ views (to queryProblem) ((E.->>. "problem").(E.^. ProblemLogInfo)))
+      , single ("company" , FilterColumn . E.mkContainsFilter  $ views (to queryProblem) ((E.->>. "company").(E.^. ProblemLogInfo)))
+      , single ("solved"  , FilterColumn . E.mkExactFilterLast $ views (to queryProblem) (E.isJust . (E.^. ProblemLogSolved)))
       ]
     dbtFilterUI mPrev = mconcat
-      [ prismAForm (singletonFilter "solved" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgAdminProblemSolved)
+      [ prismAForm (singletonFilter "user"    . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)                        (fslI MsgAdminProblemUser   & setTooltip MsgTableFilterCommaPlus)
+      , prismAForm (singletonFilter "solver"  . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)                        (fslI MsgAdminProblemSolver & setTooltip MsgTableFilterCommaPlusShort)
+      , prismAForm (singletonFilter "problem" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)                        (fslI MsgAdminProblemInfo   & setTooltip MsgAdminProblemInfoTooltip)
+      , prismAForm (singletonFilter "company" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)                        (fslI MsgTableCompanyShort)
+      , prismAForm (singletonFilter "solved"  . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgAdminProblemSolved)
       ]
     acts :: Map ProblemTableAction (AForm Handler ProblemTableActionData)
     acts = mconcat

src/Handler/Admin/Test.hs

@@ -229,7 +229,7 @@ postAdminTestR = do
   let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|]
   siteLayout locallyDefinedPageHeading $ do
   -- defaultLayout $ do
-    setTitle "Uni2work Admin Testpage"    
+    setTitle "Uni2work Admin Testpage"
 
     $(i18nWidgetFile "admin-test")
 
@@ -332,7 +332,7 @@ postAdminTestR = do
 
 getAdminTestPdfR :: Handler TypedContent
 getAdminTestPdfR = do
-  usr  <- requireAuth -- to determine language and recipient for test 
+  usr  <- requireAuth -- to determine language and recipient for test
   qual <- fromMaybeM
             (addMessage Error "Keine Qualifikation in der Datenbank zur Erzeugung eines Test-PDFs gefunden." >> redirect AdminTestR)
             (runDB $ selectFirst [] [Asc QualificationAvsLicence, Asc QualificationShorthand])
@@ -351,8 +351,9 @@ getAdminTestPdfR = do
         , qualShort     = qual ^. _qualificationShorthand . _CI
         , qualSchool    = qual ^. _qualificationSchool
         , qualDuration  = qual ^. _qualificationValidDuration
+        , qualRenewAuto = qual ^. _qualificationElearningRenews
         , isReminder    = False
-        }  
+        }
   apcIdent <- letterApcIdent letter encRecipient now
   renderLetterPDF usr letter apcIdent Nothing >>= \case
     Left err  -> sendResponseStatus internalServerError500 $ "PDF generation failed: \n" <> err
@@ -360,6 +361,6 @@ getAdminTestPdfR = do
       liftIO $ LBS.writeFile "/tmp/generated.pdf" pdf
       encryptPDF "tomatenmarmelade" pdf >>= \case
         Left err      -> sendResponseStatus internalServerError500 $ "PDFtk error: \n" <> err
-        Right encPdf  -> do 
+        Right encPdf  -> do
           liftIO $ LBS.writeFile "/tmp/crypted.pdf" encPdf
           sendByteStringAsFile "demoPDF.pdf" (LBS.toStrict pdf) now

src/Handler/PrintCenter.hs

@@ -94,6 +94,7 @@ lrqf2letter LRQF{..}
           , qualShort     = lrqfQuali ^. _qualificationShorthand . _CI
           , qualSchool    = lrqfQuali ^. _qualificationSchool
           , qualDuration  = lrqfQuali ^. _qualificationValidDuration
+          , qualRenewAuto = lrqfQuali ^. _qualificationElearningRenews
           , isReminder    = lrqfReminder
           }
     return (fromMaybe usr rcvr, SomeLetter letter)

src/Handler/Qualification.hs

@@ -102,6 +102,8 @@ mkQualificationAllTable isAdmin = do
               foldMap (textCell . formatCalendarDiffDays             ) . view (resultAllQualification . _qualificationRefreshReminder)
           , sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart)
                                                                         $ tickmarkCell . view (resultAllQualification . _qualificationElearningStart)
+          , sortable (Just "qelearrenew") (i18nCell MsgTableLmsElearningRenews & cellTooltip MsgQualificationElearningRenew)
+                                                                        $ tickmarkCell . view (resultAllQualification . _qualificationElearningRenews)
           , sortable (Just "noteexpiry") (i18nCell MsgQualificationExpiryNotification & cellTooltip MsgQualificationExpiryNotificationTooltip)
                                                                         $ tickmarkCell . view (resultAllQualification . _qualificationExpiryNotification)
           , sortable Nothing (i18nCell MsgTableQualificationIsAvsLicence & cellTooltip MsgTableQualificationIsAvsLicenceTooltip)

src/Handler/Utils/Qualification.hs

@@ -189,6 +189,8 @@ renewValidQualificationUsers qid reason renewalTime uids =
   --   E.where_ $ (qu E.^. QualificationUserQualification E.==. E.val qid )
   --       E.&&.  (qu E.^. QualificationUserUser `E.in_` E.valList uids)
   get qid >>= \case
+    Just Qualification{qualificationElearningRenews=False}
+      | Just (Right (QualificationRenewELearningBy _)) <- reason -> return 0
     Just Qualification{qualificationValidDuration=Just renewalMonths} -> do
       cutoff <- maybe (liftIO getCurrentTime) return renewalTime
       quEntsAll <- selectValidQualifications qid uids cutoff
@@ -227,7 +229,7 @@ qualificationUserBlocking ::
   , Num n
   ) => QualificationId -> [UserId] -> Bool -> Maybe UTCTime -> QualificationChangeReason -> Bool -> ReaderT (YesodPersistBackend (HandlerSite m)) m n
 qualificationUserBlocking qid uids unblock mbBlockTime (qualificationChangeReasonText -> reason) notify = do
-  $logInfoS "BLOCK" $ Text.intercalate " - " [tshow qid, tshow uids, tshow unblock, tshow mbBlockTime, tshow reason, tshow notify]
+  $logInfoS "BLOCK" $ Text.intercalate " - " [tshow qid, tshow unblock, tshow mbBlockTime, tshow reason, tshow notify, "#Users:" <> tshow (length uids), tshow uids] -- this message can get very long on test systems
   authUsr <- liftHandler maybeAuthId
   now <- liftIO getCurrentTime
   let blockTime = fromMaybe now mbBlockTime

src/Handler/Utils/Table/Columns.hs

@@ -417,12 +417,16 @@ fltrUserNameUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map F
 fltrUserNameUI = fltrUserNameLinkUI
 
 fltrUserNameLinkUI ::  Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
-fltrUserNameLinkUI = fltrUserNameLinkHdrUI MsgTableCourseMembers  
+fltrUserNameLinkUI = fltrUserNameLinkHdrUI MsgTableCourseMembers
 
 fltrUserNameLinkHdrUI :: (RenderMessage UniWorX msg) => msg -> Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
-fltrUserNameLinkHdrUI msg mPrev = 
+fltrUserNameLinkHdrUI msg mPrev =
   prismAForm (singletonFilter "user-name") mPrev $ aopt textField (fslI msg)
 
+fltrUserDisplayNameHdrUI :: (RenderMessage UniWorX msg) => msg -> Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
+fltrUserDisplayNameHdrUI msg mPrev =
+  prismAForm (singletonFilter "user-display-name") mPrev $ aopt textField (fslI msg)
+
 fltrUserNameEmailUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
 fltrUserNameEmailUI = fltrUserNameEmailHdrUI MsgTableCourseMembers
 
@@ -686,7 +690,7 @@ fltrRelevantStudyFeaturesTerms queryTermUser = singletonMap "features-terms" . F
 
 fltrRelevantStudyFeaturesTermsUI :: DBFilterUI
 fltrRelevantStudyFeaturesTermsUI = fltrStudyTermsUI
-  
+
 fltrRelevantStudyFeaturesDegree :: OpticFilterColumn' t (Set Text) (E.SqlExpr (E.Value TermId), E.SqlExpr (E.Value UserId))
 fltrRelevantStudyFeaturesDegree queryTermUser = singletonMap "features-degree" . FilterColumn $ \t criterias ->
   E.subSelectOr . E.from $ \(term `E.InnerJoin` studyFeatures) -> do
@@ -705,7 +709,7 @@ fltrRelevantStudyFeaturesDegree queryTermUser = singletonMap "features-degree" .
 fltrRelevantStudyFeaturesDegreeUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
 fltrRelevantStudyFeaturesDegreeUI mPrev =
   prismAForm (singletonFilter "features-degree") mPrev $ aopt textField (fslI MsgTableDegreeName)
-  
+
 fltrRelevantStudyFeaturesSemester :: OpticFilterColumn' t (Set Text) (E.SqlExpr (E.Value TermId), E.SqlExpr (E.Value UserId))
 fltrRelevantStudyFeaturesSemester queryTermUser = singletonMap "features-semester" . FilterColumn $ \t criterias ->
   E.subSelectOr . E.from $ \(term `E.InnerJoin` studyFeatures) -> do
@@ -741,13 +745,13 @@ fltrQualificationHdrUI msg mPrev = prismAForm (singletonFilter "qualification" .
 
 {-
 -- colUserCompany :: (HandlerSite (DBCell m) ~ UniWorX, IsDBTable m c, HasEntity a User) => Colonnade Sortable a (DBCell m c)
-colUserCompany = sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \heu -> do   
+colUserCompany = sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \heu -> do
       let uid = heu ^. hasEntity . _entityKey
       companies' <- liftHandler . runDB . E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
         E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
         E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
         return (comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
-      let companies = intersperse (text2markup ", ") $ 
+      let companies = intersperse (text2markup ", ") $
             (\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies'
           icnSuper = text2markup " " <> icon IconSupervisor
       cell $ toWgt $ mconcat companies
@@ -756,13 +760,13 @@ colUserCompany = sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \
 -- PROBLEM: how to type sqlCell compatible with dbTable that as actions, i.e. MForm instead of YesodDB?
 colUserCompany :: (IsDBTable (YesodDB UniWorX) c, HasEntity a User) => Colonnade Sortable a (DBCell (YesodDB UniWorX) c)
 colUserCompany = sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \heu ->
-      let uid = heu ^. hasEntity . _entityKey in 
+      let uid = heu ^. hasEntity . _entityKey in
-      sqlCell $ do 
+      sqlCell $ do
         companies' <- E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
           E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
           E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
           return (comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
-        let companies = intersperse (text2markup ", ") $ 
+        let companies = intersperse (text2markup ", ") $
               (\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies'
             icnSuper = text2markup " " <> icon IconSupervisor
         pure $ toWgt $ mconcat companies
@@ -803,12 +807,12 @@ fltrCompanyNameNr query = ("company-name-number", FilterColumn $ \needle (setFol
     let numCrits    = setMapMaybe readMay criterias
         fltrCName   = mkContainsFilterWith CI.mk (query >>> (E.^. CompanyName))      needle criterias
         fltrCShort  = mkContainsFilterWith CI.mk (query >>> (E.^. CompanyShorthand)) needle criterias
-        fltrCno     = mkExactFilter              (query >>> (E.^. CompanyAvsId))     needle numCrits       
+        fltrCno     = mkExactFilter              (query >>> (E.^. CompanyAvsId))     needle numCrits
     in if null numCrits
         then fltrCName E.||. fltrCShort
-        else fltrCName E.||. fltrCShort E.||. fltrCno      
+        else fltrCName E.||. fltrCShort E.||. fltrCno
     )
-  where 
+  where
     setFoldMap :: (Text -> Set.Set Text) -> Set.Set Text -> Set.Set Text
     setFoldMap = foldMap
 
@@ -825,22 +829,22 @@ fltrCompanyNameNrHdrUI msg mPrev =
 ---------
 
 
-fltrAVSCardNos :: (IsFilterColumnHandler t ([Text] -> Handler (a -> E.SqlExpr (E.Value Bool))), IsString k) 
+fltrAVSCardNos :: (IsFilterColumnHandler t ([Text] -> Handler (a -> E.SqlExpr (E.Value Bool))), IsString k)
               => (a -> E.SqlExpr (Entity User)) -> Map k (FilterColumn t fs)
 fltrAVSCardNos queryUser = Map.singleton "avs-card" fch
-  where 
+  where
     fch = FilterColumnHandler $ \case
       [] -> return (const E.true)
       cs -> do
         let crds = mapMaybe parseAvsCardNo $ foldMap anySeparatedText cs
         toutsecs <- getsYesod $ preview $ _appAvsConf . _Just . _avsTimeout
-        maybeTimeoutHandler toutsecs (try $ queryAvsCardNos crds) >>= \case 
+        maybeTimeoutHandler toutsecs (try $ queryAvsCardNos crds) >>= \case
-          Nothing               -> addMessageI Error MsgAvsCommunicationTimeout 
+          Nothing               -> addMessageI Error MsgAvsCommunicationTimeout
                                 >> return (const E.false)
           (Just (Left err))     -> addMessage  Error (someExc2Html err)
                                 >> return (const E.false)
           (Just (Right (null -> True))) -> return (const E.false)
-          (Just (Right apids)) -> return $ 
+          (Just (Right apids)) -> return $
             \(queryUser -> user) ->
               E.exists $ E.from $ \usrAvs ->
                 E.where_ $ usrAvs E.^. UserAvsUser E.==. user E.^. UserId
@@ -849,8 +853,8 @@ fltrAVSCardNos queryUser = Map.singleton "avs-card" fch
     someExc2Html (SomeException e) = text2Html $ tshow e
 
 fltrAVSCardNosUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
-fltrAVSCardNosUI mPrev = 
+fltrAVSCardNosUI mPrev =
-  prismAForm (singletonFilter "avs-card" ) mPrev $ 
+  prismAForm (singletonFilter "avs-card" ) mPrev $
     aopt textField (fslI MsgAvsCardNo & setTooltip (SomeMessages [SomeMessage MsgTableFilterComma, SomeMessage MsgAvsQueryNeeded]))
 
 

src/Jobs/Handler/LMS.hs

@@ -336,7 +336,7 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
                 -- ok_unblock <- qualificationUserUnblockByReason qid [lmsUserUser luser] repTime (Right QualificationBlockFailedELearning) reason_undo False -- affects audit log
                 -- when (ok_unblock > 0) ($logWarnS "LMS" [st|LMS Result: workaround triggered, unblocking #{tshow ok_unblock} e-learners for #{tshow qid} having success reported after initially failed e-learning|])
                 -- END LMS WORKAROUND 2
-                ok_renew <- renewValidQualificationUsers qid reason repDay [lmsUserUser luser]-- only valid qualifications are truly renewed; transcribes to audit log
+                ok_renew <- renewValidQualificationUsers qid reason repDay [lmsUserUser luser]  -- only valid qualifications are truly renewed and only if validDuration is set and elearningRenews is true; transcribes to audit log
                 update luid [LmsUserStatus =. Just LmsSuccess, LmsUserStatusDay =. repDay]
                 return $ Sum ok_renew
           in lrepQry lrFltrSuccess

src/Jobs/Handler/SendNotification/Qualification.hs

@@ -25,7 +25,7 @@ dispatchNotificationQualificationExpiry :: QualificationId -> Day -> UserId -> H
 dispatchNotificationQualificationExpiry nQualification dExpiry jRecipient = userMailT jRecipient $ do
   (recipient@User{..}, Qualification{..}) <- liftHandler . runDB $ (,)
     <$> getJust jRecipient
-    <*> getJust nQualification    
+    <*> getJust nQualification
 
   encRecipient :: CryptoUUIDUser <- liftHandler $ encrypt jRecipient
   let entRecipient = Entity jRecipient recipient
@@ -43,19 +43,19 @@ dispatchNotificationQualificationExpiry nQualification dExpiry jRecipient = user
 
 
 dispatchNotificationQualificationExpired :: QualificationId -> UserId -> Handler ()
-dispatchNotificationQualificationExpired nQualification jRecipient = do  
+dispatchNotificationQualificationExpired nQualification jRecipient = do
   encRecipient :: CryptoUUIDUser <- encrypt jRecipient
   encRecShort <- encrypt jRecipient
   dbRes <- runDB $ (,,)
     <$> get jRecipient
     <*> get nQualification
-    <*> getBy (UniqueQualificationUser nQualification jRecipient)    
+    <*> getBy (UniqueQualificationUser nQualification jRecipient)
 
-  case dbRes of 
+  case dbRes of
     ( Just User{..}, Just Qualification{..}, Just (Entity quId QualificationUser{..})) -> do
       now <- liftIO getCurrentTime
       qub_entry <- entityVal <<$>> runDB (selectRelevantBlock now quId)
-      let block = filterMaybe (not . qualificationUserBlockUnblock) qub_entry 
+      let block = filterMaybe (not . qualificationUserBlockUnblock) qub_entry
       urender <- getUrlRender
       let expDay  = maybe qualificationUserValidUntil (min qualificationUserValidUntil . utctDay . qualificationUserBlockFrom) block
           qname   = CI.original qualificationName
@@ -94,30 +94,30 @@ dispatchNotificationQualificationRenewal nQualification nReminder jRecipient = d
     <*> get nQualification
     <*> getBy (UniqueQualificationUser    nQualification jRecipient)
     <*> getBy (UniqueLmsQualificationUser nQualification jRecipient)
-  case query of 
+  case query of
     (Just User{userDisplayName, userSurname}, Just Qualification{..}, Just (Entity _ QualificationUser{..}), Just(Entity luid LmsUser{..})) -> do
       let qname = CI.original qualificationName
           letter = LetterRenewQualification
-            { lmsLogin     = lmsUserIdent
+            { lmsLogin      = lmsUserIdent
-            , lmsPin       = lmsUserPin
+            , lmsPin        = lmsUserPin
-            , qualHolderID = jRecipient
+            , qualHolderID  = jRecipient
-            , qualHolderDN = userDisplayName 
+            , qualHolderDN  = userDisplayName
-            , qualHolderSN = userSurname
+            , qualHolderSN  = userSurname
-            , qualExpiry   = qualificationUserValidUntil
+            , qualExpiry    = qualificationUserValidUntil
-            , qualId       = nQualification            
+            , qualId        = nQualification
-            , qualName     = qname
+            , qualName      = qname
-            , qualShort    = CI.original qualificationShorthand                                
+            , qualShort     = CI.original qualificationShorthand
-            , qualSchool   = qualificationSchool            
+            , qualSchool    = qualificationSchool
-            , qualDuration = qualificationValidDuration
+            , qualDuration  = qualificationValidDuration
-            , isReminder   = nReminder
+            , qualRenewAuto = qualificationElearningRenews
+            , isReminder    = nReminder
             }
       $logInfoS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal of qualification " <> qname
       notifyOk <- sendEmailOrLetter jRecipient letter
-      when notifyOk $ do 
+      when notifyOk $ do
         now <- liftIO getCurrentTime
         runDB $ update luid [ LmsUserNotified =. Just now]
     (_, Nothing, _, _) -> $logErrorS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: Qualification " <> tshow nQualification <> " does not exist!"
     (Nothing, _, _, _) -> $logErrorS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: User does not exist!"
     (_, _, Nothing, _) -> $logErrorS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: QualificationUser does not exist, i.e. user does not have this qualification!"
     (_, _, _, Nothing) -> $logWarnS  "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: LmsUser does not exist!"
-    

src/Utils/Print/ExpireQualification.hs

@@ -6,7 +6,7 @@
 
 module Utils.Print.ExpireQualification where
 
-import Import 
+import Import
 
 -- import           Data.Char as Char
 -- import qualified Data.Text as Text
@@ -24,33 +24,28 @@ data LetterExpireQualification = LetterExpireQualification
     , leqHolderSN  :: UserSurname
     , leqExpiry    :: Maybe Day
     , leqId        :: QualificationId
-    , leqName      :: Text            
+    , leqName      :: Text
-    , leqShort     :: Text       
+    , leqShort     :: Text
     , leqSchool    :: SchoolId
     , leqUrl       :: Maybe Text
     }
   deriving (Eq, Show)
 
 
-instance MDLetter LetterExpireQualification where  
+instance MDLetter LetterExpireQualification where
   encryptPDFfor     _ = NoPassword
   getLetterKind     _ = Din5008
   getLetterEnvelope _ = 'e'
   getMailSubject    l = SomeMessage $ MsgMailSubjectQualificationExpired $ leqShort l
 
-{-
-  getTemplate LetterExpireQualification{leqShort="F"} 
-                = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_f_expiry.md")
-  getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_generic_expiry.md")
--}  
   getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_licence_expiry.md")
 
-  letterMeta LetterExpireQualification{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} = 
+  letterMeta LetterExpireQualification{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} =
     let isSupervised = rcvrId /= leqHolderID
         (qArea, qFormal, qLicence) = qualificationText lang leqName leqShort
     in mkMeta $
       guardMonoid isSupervised
-      [ toMeta "supervisor" userDisplayName      
+      [ toMeta "supervisor" userDisplayName
       ] <>
       [ toMeta "lang"           lang
       , toMeta "licencename"    leqName
@@ -59,14 +54,14 @@ instance MDLetter LetterExpireQualification where
       , toMeta "subject-meta"   leqHolderDN
       , mbMeta "expiry"         (format SelFormatDate <$> leqExpiry)
       , mbMeta "licence-url"    leqUrl
-      , toMeta "de-opening"   $ bool ("Guten Tag " <> leqHolderDN <> ",") "Sehr geehrte Damen und Herren," isSupervised
+      , toMeta "de-opening"   $ bool [st|Guten Tag #{leqHolderDN},|] [st|Guten Tag #{userDisplayName},|] isSupervised
-      , toMeta "en-opening"   $ bool ("Dear "      <> leqHolderDN <> ",") "Dear supervisor,"               isSupervised
+      , toMeta "en-opening"   $ bool [st|Dear #{leqHolderDN},|]      [st|Dear #{userDisplayName},|]      isSupervised
-      , toMeta "de-subject"     [st|Entzug "#{leqShort}" (#{qLicence})|]
+      , toMeta "de-subject"     [st|Entzug Fahrberechtigung „#{leqShort}“ (#{qLicence})|]
-      , toMeta "en-subject"     [st|Revocation "#{leqShort}" (#{qLicence})|]                                
+      , toMeta "en-subject"     [st|Revocation driving licence "#{leqShort}" (#{qLicence})|]
       , toMeta "qarea"          qArea
       , toMeta "qformal"        qFormal
       , toMeta "qlicence"       qLicence
-      ] 
+      ]
 
   getPJId LetterExpireQualification{..} =
     PrintJobIdentification
@@ -78,7 +73,7 @@ instance MDLetter LetterExpireQualification where
       , pjiCourse           = Nothing
       , pjiQualification    = Just leqId
       , pjiLmsUser          = Nothing
-      , pjiFileName         = "expire_" <> CI.original (unSchoolKey leqSchool) <> "-" <> leqShort <> "_" <> leqHolderSN 
+      , pjiFileName         = "expire_" <> CI.original (unSchoolKey leqSchool) <> "-" <> leqShort <> "_" <> leqHolderSN
         -- let nameRecipient = abbrvName <$> recipient
         --     nameSender    = abbrvName <$> sender
         --     nameCourse    = CI.original . courseShorthand        <$> course

src/Utils/Print/RenewQualification.hs

@@ -6,7 +6,7 @@
 
 module Utils.Print.RenewQualification where
 
-import Import 
+import Import
 import Text.Hamlet
 
 import           Data.Char as Char
@@ -19,55 +19,73 @@ import Utils.Print.Letters
 import Handler.Utils.Widgets (nameHtml) -- , nameHtml')
 import Handler.Utils.Qualification (computeNewValidDate)
 
--- TODO: refactor me and turn me into a qualification property (elearningOnly)
-qualificationPractical :: Text -> Bool
-qualificationPractical qshort = "R" == qshort -- TODO
 
-
+defaultNotice :: Bool ->  Lang -> Text -> Text -> Text -> [Text]
-defaultNotice :: Lang -> Text -> Text -> Text -> [Text]
+defaultNotice renewAuto l qualName qualShort newExpire
-defaultNotice l qualName qualShort newExpire
+  | isDe l, renewAuto
-  | isDe l, qualificationPractical qualShort
+    = [ [st|Ein Zertifikat für Ihre Unterlagen kann nur direkt nach dem erfolgreichen Test erstellt werden.
-    = [ [st|Ein Zertifikat für Ihre Unterlagen kann nur direkt nach dem erfolgreichen Test erstellt werden. 
+            Das Zertifikat wird auf die Benutzerkennung ausgestellt. Zusammen mit diesem Schreiben können Sie Ihrem Arbeitgeber zeigen, dass Sie bestanden haben.
-            Das Zertifikat wird auf die Benutzerkennung ausgestellt. Zusammen mit diesem Schreiben können Sie Ihrem Arbeitgeber zeigen, dass Sie bestanden haben. 
+            Bei erfolgreichem Abschluss der Schulung verlängert sich das Ablaufdatum automatisch auf den #{newExpire}.
-            Bei erfolgreichem Abschluss der Schulung verlängert sich das Ablaufdatum automatisch auf den #{newExpire}. Wir empfehlen die Schulung zeitnah durchzuführen. 
+            Wir empfehlen die Schulung zeitnah durchzuführen.
-            Sollte bis zum Ablaufdatum das E-Learning und der Praxisteil nicht erfolgreich abgeschlossen sein oder der Test nach 5 Versuchen nicht bestanden werden, muss zur Wiedererlangung der Fahrberechtigung „#{qualShort}“ ein Grundkurs #{qualName} bei der Fahrerausbildung absolviert werden.|]
+            Sollte bis zum Ablaufdatum das E-Learning nicht innerhalb von 5 Versuchen erfolgreich abgeschlossen sein, muss zur Wiedererlangung der Fahrberechtigung „#{qualShort}“ ein Grundkurs #{qualName} bei der Fraport Fahrerausbildung absolviert werden.|]
-      , "Benötigen Sie die Fahrberechtigung nicht mehr, informieren Sie bitte die Fahrerausbildung."
+      , "Benötigen Sie die Fahrberechtigung nicht mehr, informieren Sie bitte die Fraport Fahrerausbildung."
-      ]
-  | isDe l
-    = [ [st|Ein Zertifikat für Ihre Unterlagen kann nur direkt nach dem erfolgreichen Test erstellt werden. 
-            Das Zertifikat wird auf die Benutzerkennung ausgestellt. Zusammen mit diesem Schreiben können Sie Ihrem Arbeitgeber zeigen, dass Sie bestanden haben. 
-            Bei erfolgreichem Abschluss der Schulung verlängert sich das Ablaufdatum automatisch auf den #{newExpire}. Wir empfehlen die Schulung zeitnah durchzuführen. 
-            Sollte bis zum Ablaufdatum das E-Learning nicht erfolgreich abgeschlossen sein oder der Test nach 5 Versuchen nicht bestanden werden, muss zur Wiedererlangung der Fahrberechtigung „#{qualShort}“ ein Grundkurs #{qualName} bei der Fahrerausbildung absolviert werden.|]
-      , "Benötigen Sie die Fahrberechtigung nicht mehr, informieren Sie bitte die Fahrerausbildung."
       , "(Please contact us if you prefer letters in English.)"
       ]
-  | otherwise
+  | isDe l
-    = [ [st|A certificate for your records can only be generated immediately after a successful test. 
+    = [ [st|Ein Zertifikat für Ihre Unterlagen kann nur direkt nach dem erfolgreichen Test erstellt werden.
-            The certificate will be issued for the user login. The certificate and this letter may then prove that you have passed. 
+            Das Zertifikat wird auf die Benutzerkennung ausgestellt. Zusammen mit diesem Schreiben können Sie Ihrem Arbeitgeber zeigen, dass Sie bestanden haben.
-            Upon successful completion of the training, the expiry date will automatically be extended until #{newExpire}. We recommend completing the training as soon as possible. 
+            Wir empfehlen die Schulung zeitnah durchzuführen.
-            The licence irrevocably expires, if the e-learning is not successfully completed by the expiry date or after 5 failed attempts. In this case, regaining licence "#{qualShort}" requires the completing of a normal training course #{qualName} again, as if no prior experience existed.|]
+            Sollte bis zum Ablaufdatum das E-Learning und der Praxisteil nicht erfolgreich abgeschlossen sein, muss zur Wiedererlangung der Fahrberechtigung „#{qualShort}“ ein Grundkurs #{qualName} bei der Fraport Fahrerausbildung absolviert werden.|]
+      , "Benötigen Sie die Fahrberechtigung nicht mehr, informieren Sie bitte die Fraport Fahrerausbildung."
+      ]
+  | renewAuto
+    = [ [st|A certificate for your records can only be generated immediately after a successful test.
+            The certificate will be issued for the user login. The certificate and this letter may then prove that you have passed.
+            Upon successful completion of the training, the expiry date will automatically be extended until #{newExpire}.
+            We recommend completing the training as soon as possible.
+            The licence irrevocably expires, if the e-learning is not successfully completed within 5 attempts by the expiry date. In this case, regaining licence "#{qualShort}" requires the completing of a normal training course #{qualName} again, as if no prior experience existed.|]
       , "Please inform us, if this driving licence is no longer required."
       , "(Kontaktieren Sie uns bitte, um zukünftige Briefe von uns in deutscher Sprache zu erhalten.)"
       ]
-  
+  | otherwise
+      = [ [st|A certificate for your records can only be generated immediately after a successful test.
+            The certificate will be issued for the user login. The certificate and this letter may then prove that you have passed.
+            We recommend completing the training as soon as possible.
+            The licence irrevocably expires, if the e-learning is not successfully completed within 5 attempts by the expiry date. In this case, regaining licence "#{qualShort}" requires the completing of a normal training course #{qualName} again, as if no prior experience existed.|]
+      , "Please inform us, if this driving licence is no longer required."
+      , "(Kontaktieren Sie uns bitte, um zukünftige Briefe von uns in deutscher Sprache zu erhalten.)"
+      ]
+
+isAnyDrivingLicence :: Text -> Maybe Text
+-- isAnyDrivingLicence = firstJust (Text.stripSuffix "führerschein") . Text.words . Text.replace "-" " " . Text.replace "+" ""
+isAnyDrivingLicence = firstJust (Text.stripSuffix "führerschein") . Text.words . Text.map anyNonAlphaToBlank
+
+anyNonAlphaToBlank :: Char -> Char
+anyNonAlphaToBlank c
+  | Char.isAlpha c
+    = c
+  | otherwise = ' '
 
 qualificationText :: Lang -> Text -> Text -> (Text, Text, Text) -- (qarea, qformal, qlicence) i.e. (Rollfeld, Rollfeldfahrberechtigung, Rollfeldführerschein) translated
-qualificationText l qName@(Text.stripSuffix "führerschein" -> Just qPrefix) qShort
-  | isDe l
-    = (qPrefix, qPrefix <> "fahrberechtigung", qName)
-  | qShort == "F"
-    = ("apron", "apron driving licence", "apron driving licence")
-  | qShort == "R"
-    = ("maneuvering area", "maneuvering area driving licence", "maneuvering area driving licence")
-  | otherwise
-    = (qPrefix, qPrefix <> " driving licence", qName)
 qualificationText l _qName "GSS"
   | isDe l
     = ("Gabelstapler", "Fahrberechtigung Gabelstapler", "Gabelstaplerführerschein")
   | otherwise
-    = ("Forklift", "forklift driving licence", "forklift driving licence")
+    = ("forklift", "forklift driving licence", "forklift driving licence")
-qualificationText _l qName qShort
+qualificationText l qName@(isAnyDrivingLicence -> Just qPrefix) qShort
-    = (qShort, qName, qName)
+  | isDe l
+    = (qPrefix, [st|Fahrberechtigung „#{qShort}“|], qName)
+  | qShort == "F"
+    = ("apron", [st|driving licence "#{qShort}"|], "apron driving licence")
+  | Text.isPrefixOf "R" qShort
+    = ("maneuvering area", [st|driving licence "#{qShort}"|], "maneuvering area driving licence")
+  | otherwise
+    = (qPrefix, qPrefix <> " driving licence", qName)
+qualificationText l qName qShort
+  | isDe l
+    = (qShort, [st|Fahrberechtigung „#{qShort}“|], qName)
+  | otherwise
+    = (qShort,  [st|driving licence "#{qShort}"|], qName)
 
 
 data LetterRenewQualification = LetterRenewQualification
@@ -82,25 +100,26 @@ data LetterRenewQualification = LetterRenewQualification
     , qualShort     :: Text
     , qualSchool    :: SchoolId
     , qualDuration  :: Maybe Int
+    , qualRenewAuto :: Bool
     , isReminder    :: Bool
     }
   deriving (Eq, Show)
 
 
 -- this datatype is specific to this letter only, and just to avoid code duplication for derived data or constants
-data LetterRenewQualificationData = LetterRenewQualificationData { lmsUrl, lmsUrlLogin, lmsUrlPassword, lmsIdent :: Text } 
+data LetterRenewQualificationData = LetterRenewQualificationData { lmsUrl, lmsUrlLogin, lmsUrlPassword, lmsIdent :: Text }
   deriving (Eq, Show)
 
 letterRenewalQualificationFData :: LetterRenewQualification -> LetterRenewQualificationData
 letterRenewalQualificationFData LetterRenewQualification{lmsLogin, lmsPin} = LetterRenewQualificationData{..}
-  where 
+  where
     lmsUrl          = "drive.fraport.de"
     lmsUrlLogin     = "https://" <> lmsUrl <> "/?username=" <> lmsIdent
     lmsUrlPassword  = lmsUrlLogin <> "&password=" <> lmsPin
     lmsIdent        = getLmsIdent lmsLogin
 
 
-instance MDLetter LetterRenewQualification where  
+instance MDLetter LetterRenewQualification where
   encryptPDFfor     _ = PasswordUnderling
   getLetterKind     _ = PinLetter
   getLetterEnvelope l = maybe 'q' (Char.toLower . fst) $ Text.uncons (qualShort l)
@@ -110,22 +129,20 @@ instance MDLetter LetterRenewQualification where
     let LetterRenewQualificationData{..} = letterRenewalQualificationFData l
     in $(ihamletFile "templates/mail/body/qualificationRenewal.hamlet")
 
-  letterMeta l@LetterRenewQualification{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} = 
+  letterMeta l@LetterRenewQualification{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} =
-    let LetterRenewQualificationData{..} = letterRenewalQualificationFData l 
+    let LetterRenewQualificationData{..} = letterRenewalQualificationFData l
         isSupervised = rcvrId /= qualHolderID
         newExpire = computeNewValidDate (fromMaybe 0 qualDuration) qualExpiry
         (qArea, qFormal, qLicence) = qualificationText lang qualName qualShort
     in mkMeta $
       guardMonoid isSupervised
       [ toMeta "supervisor" userDisplayName
-      , toMeta "de-opening" ("Sehr geehrte Damen und Herren,"::Text)
-      , toMeta "en-opening" ("Dear Sir or Madam,"::Text)
       ] <>
       guardMonoid isReminder
       [ toMeta "reminder"       ("reminder"::Text)
       ] <>
-      guardMonoid (qualificationPractical qualShort)
+      guardMonoid (not qualRenewAuto)
-      [ toMeta "practical"      True
+      [ toMeta "practical"      True          -- note: definied or undefined matters, bool value is unimportant
       ] <>
       [ toMeta "lang"           lang
       , toMeta "login"          lmsIdent
@@ -136,11 +153,11 @@ instance MDLetter LetterRenewQualification where
       , mbMeta "validduration"  (show <$> qualDuration)
       , toMeta "url-text"       lmsUrl
       , toMeta "url"            lmsUrlPassword -- ok for PDF, since it contains the PIN already
-      , toMeta "notice"       $ defaultNotice lang qualName qualShort $ format SelFormatDate newExpire
+      , toMeta "notice"       $ defaultNotice qualRenewAuto lang qualName qualShort $ format SelFormatDate newExpire
       , toMeta "de-subject"     [st|Verlängerung Fahrberechtigung „#{qualShort}“ (#{qualName})|]
-      , toMeta "en-subject"     [st|Renewal of driving licence „#{qualShort}“ (#{qualName})|]
+      , toMeta "en-subject"     [st|Renewal of driving licence "#{qualShort}" (#{qualName})|]
-      , toMeta "de-opening"   $ bool ("Guten Tag " <> qualHolderDN <> ",") "Sehr geehrte Damen und Herren," isSupervised
+      , toMeta "de-opening"   $ bool [st|Guten Tag #{qualHolderDN},|] [st|Guten Tag #{userDisplayName},|] isSupervised
-      , toMeta "en-opening"   $ bool ("Dear "      <> qualHolderDN <> ",") "Dear supervisor,"               isSupervised  
+      , toMeta "en-opening"   $ bool [st|Dear #{qualHolderDN},|]      [st|Dear #{userDisplayName},|]      isSupervised
       , toMeta "qarea"          qArea
       , toMeta "qformal"        qFormal
       , toMeta "qlicence"       qLicence
@@ -156,7 +173,7 @@ instance MDLetter LetterRenewQualification where
       , pjiCourse           = Nothing
       , pjiQualification    = Just qualId
       , pjiLmsUser          = Just lmsLogin
-      , pjiFileName         = "renew_" <> CI.original (unSchoolKey qualSchool) <> "-" <> qualShort <> "_" <> qualHolderSN 
+      , pjiFileName         = "renew_" <> CI.original (unSchoolKey qualSchool) <> "-" <> qualShort <> "_" <> qualHolderSN
         -- let nameRecipient = abbrvName <$> recipient
         --     nameSender    = abbrvName <$> sender
         --     nameCourse    = CI.original . courseShorthand        <$> course

templates/letter/fraport_f_expiry.md

@@ -1,146 +0,0 @@
----
-### Metadaten, welche hier eingestellt werden:
-# Absender
-author: Fraport AG - Fahrerausbildung (AVN-AR)
-phone: +49 69 690-30306
-email: fahrerausbildung@fraport.de
-place: Frankfurt am Main
-return-address: 
- - 60547 Frankfurt
-de-opening: Liebe Fahrberechtigungsinhaber,
-en-opening: Dear driver,
-de-closing: |
-  Mit freundlichen Grüßen,  
-    Ihre Fraport Fahrerausbildung
-en-closing: |
-  With kind regards,  
-    Your Fraport Driver Training
-encludes:
-hyperrefoptions: hidelinks
-
-### Metadaten, welche automatisch ersetzt werden:
-de-subject: 'Entzug "F" (Vorfeldführerschein)'
-en-subject: Revocation of apron driving license
-date: 11.11.1111
-lang: de-de
-is-de: true
-# Emfpänger
-licenceholder: P. Rüfling
-address:
- - E. M. Pfänger
- - Musterfirma GmbH
- - Musterstraße 11
- - 12345 Musterstadt
-...
-$if(titleblock)$
-$titleblock$
-
-$endif$
-$for(header-includes)$
-$header-includes$
-        
-$endfor$
-$for(include-before)$
-$include-before$
-
-$endfor$
-
-$if(is-de)$
-
-<!-- deutsche Version des Briefes  -->
-$if(supervisor)$
-  leider hat **$licenceholder$**
-$else$
-  leider haben Sie
-$endif$
-den Wissenstest im Rahmen des Recurrent Trainings Vorfeldführerschein nicht bestanden 
-oder die Ablauffrist nicht eingehalten.  
-
-
-Die Qualifikation „Vorfeldführerschein“ ist somit 
-$if(expiry)$
-  seit $expiry$ 
-$endif$
-nicht mehr gültig.  
-
-
-$if(supervisor)$
-$if(licence-url)$
-[$licenceholder$]($licence-url$) 
-$else$
-$licenceholder$ 
-$endif$
-darf 
-$else$
-  Sie dürfen 
-$endif$
-ab sofort keine Fahrzeuge mehr eigenständig auf dem Vorfeld des Frankfurter Flughafens führen.
-
-
-Um die Fahrberechtigung wiederzuerlangen, ist die Teilnahme an einem Grundkurs Vorfeldführerschein erforderlich.
-
-$if(supervisor)$
-Hierfür wenden Sie sich bitte an die Fahrerausbildung der Fraport AG unter:
-
-Telefon
-  
-  : [$phone$](tel:$phone$)
-
-Email
-  
-  : [$email$](mailto:$email$)
-
-$else$
-Hierfür wenden Sie sich bitte an Ihren Arbeitgeber.
-$endif$
-
-$else$ 
-<!-- englische Version des Briefes  -->
-we regret to inform you that 
-$if(supervisor)$
-  **$licenceholder$**
-$else$
-  you
-$endif$
-did not pass the required knowledge test within the allotted time
-for the renewal of the apron driving licence.
-
-
-The qualification „Vorfeldführerschein“ (apron driving lincence) is therefore invalid
-$if(expiry)$
-  since $expiry$.
-$else$
-  now.
-$endif$ 
-
-$if(supervisor)$
-$if(licence-url)$
-[$licenceholder$]($licence-url$) 
-$else$
-$licenceholder$ 
-$endif$
-$else$
-  You
-$endif$
-may no longer drive a vehicle on the apron of Frankfurt airport, effective immediately.
-
-
-In order to regain this apron driving licence, a full participation in a
-basic training course is required.
-
-$if(supervisor)$
-Please contact the Fraport driving school team, if you want to book a course:
-
-Phone
-  
-  : [$phone$](tel:$phone$)
-
-Email
-  
-  : [$email$](mailto:$email$)
-
-$else$
-Please contact your employer to book a course for you.
-$endif$
-
-$endif$

templates/letter/fraport_f_expiry.md.license

@@ -1,3 +0,0 @@
-SPDX-FileCopyrightText: 2023-24 Steffen Jost <S.Jost@Fraport.de>
-
-SPDX-License-Identifier: LicenseRef-Fraport-Corporate-Design

templates/letter/fraport_licence_expiry.md

@@ -9,14 +9,16 @@ email: fahrerausbildung@fraport.de
 place: Frankfurt am Main
 return-address: 
  - 60547 Frankfurt
-de-opening: Sehr geehrte Damen und Herren,
+de-opening: Guten Tag,
 en-opening: Dear driver,
 de-closing: |
-  Mit freundlichen Grüßen,  
+  Mit freundlichen Grüßen  
-    Fraport Fahrerausbildung
+  \vspace{2EX}
+  Fraport Fahrerausbildung
 en-closing: |
-  With kind regards,  
+  With kind regards  
-    Fraport Driver Training
+  \vspace{2EX}
+  Fraport Driver Training
 encludes:
 hyperrefoptions: hidelinks
 
@@ -53,11 +55,11 @@ $if(supervisor)$
 $else$
   leider haben Sie
 $endif$
-den Wissenstest im Rahmen des Recurrent Trainings $qlicence$ nicht bestanden 
+das Recurrent Training $qlicence$ nicht bestanden 
 oder die Ablauffrist nicht eingehalten.  
 
 
-**Die Qualifikation „$qformal$“ ist somit
+**Die Qualifikation $qformal$ ist somit
 $if(expiry)$
   seit $expiry$
 $endif$
@@ -74,14 +76,14 @@ darf
 $else$
   Sie dürfen 
 $endif$
-ab sofort keine Fahrzeuge mehr eigenständig auf dem $qarea$ des Frankfurter Flughafens führen.
+ab sofort keine Fahrzeuge mehr eigenständig auf dem $qarea$ des Verkehrsflughafens Frankfurt/Main führen.
 
 
 Um die Fahrberechtigung wiederzuerlangen, ist die Teilnahme an einem 
-Grundkurs $qlicence$ bei der Fahrerausbildung erforderlich.
+Grundkurs $qlicence$ bei der Fraport Fahrerausbildung erforderlich.
 
-$if(supervisor)$
+
-Hierfür wenden Sie sich bitte an die Fahrerausbildung der Fraport AG unter:
+Hierfür wenden Sie sich bitte an die Fraport Fahrerausbildung unter:
 
 Telefon
   
@@ -91,9 +93,6 @@ Email
   
   : [$email$](mailto:$email$)
 
-$else$
-Hierfür wenden Sie sich bitte an Ihren Arbeitgeber.
-$endif$
 
 $else$ 
 <!-- englische Version des Briefes  -->
@@ -103,8 +102,9 @@ $if(supervisor)$
 $else$
   you
 $endif$
-did not pass the required knowledge test within the allotted time
+did not pass the reccurrent training 
-for the renewal of the $qlicence$.
+for the renewal of the $qlicence$
+within the allotted time.  
 
 
 **The qualification „$licencename$“ ($qformal$) is therefore invalid
@@ -123,13 +123,13 @@ $endif$
 $else$
   You
 $endif$
-may no longer drive a vehicle on the $qarea$ of Frankfurt airport, effective immediately.
+may no longer drive a vehicle on the $qarea$ of airport Frankfurt/Main, effective immediately.
 
 
 In order to regain this $qlicence$, a full participation in a
 basic training course is required.
 
-$if(supervisor)$
+
 Please contact Fraport Driver Training, if you want to book a course:
 
 Phone
@@ -140,8 +140,4 @@ Email
   
   : [$email$](mailto:$email$)
 
-$else$
-Please contact your employer to book a course for you.
-$endif$
-
 $endif$

templates/letter/fraport_renewal.md

@@ -7,14 +7,16 @@ email: fahrerausbildung@fraport.de
 place: Frankfurt am Main
 return-address: 
  - 60547 Frankfurt
-de-opening: Sehr geehrte Damen und Herren,
+de-opening: Guten Tag,
 en-opening: Dear driver,
 de-closing: |
-  Mit freundlichen Grüßen,  
+  Mit freundlichen Grüßen  
-    Fraport Fahrerausbildung
+  \vspace{2EX}
+  Fraport Fahrerausbildung
 en-closing: |
-  With kind regards,  
+  With kind regards  
-    Fraport Driver Training
+  \vspace{2EX}
+  Fraport Driver Training
 encludes:
 hyperrefoptions: colorlinks=false
 
@@ -22,8 +24,8 @@ hyperrefoptions: colorlinks=false
 de-subject: 'Verlängerung Fahrberechtigung "F" (Vorfeldführerschein)'
 en-subject: Renewal of apron driving license
 qarea: 'Vorfeld'
-qformal: 'Vorfeldfahrberechtigung'
+qformal: 'Fahrberechtigung'
-qlicence: 'Vorfeldführerschein'
+qlicence: 'Führerschein'
 url-text: 'drive.fraport.de'
 url: 'https://drive.fraport.de'
 date: 11.11.1111
@@ -85,8 +87,8 @@ $if(supervisor)$
 Ausschließlich Sie sind berechtigt, die Benutzerdaten an den Schulungsteilnehmer auszuhändigen. 
 $endif$
 
-Für die Absolvierung der Schulungsmaßnahme werden 1--2 Stunden benötigt.
+Für die Absolvierung der Schulungsmaßnahme werden ca. 2 Stunden benötigt.
-Der Abschluss der Schulung wird automatisch an das System der Fahrerausbildung übermittelt.
+Der Abschluss der Schulung wird automatisch an das System der Fraport Fahrerausbildung übermittelt.
 
 $if(practical)$
  Nach erfolgreichem Abschluss der Online-Schulung
@@ -97,11 +99,11 @@ $if(practical)$
  $endif$
  sich von Ihrer Firma zum praktischen Teil der Schulung
  $if(supervisor)$
- einplanen lassen.
+ anmelden lassen.
  $else$
- einplanen.
+ anmelden.
  $endif$
- Im Rahmen der 3--4-stündigen praktischen Auffrischung erfolgen Funkübungen 
+ Im Rahmen der ca. 4-stündigen praktischen Auffrischung erfolgen Funkübungen 
  sowie die Durchführung einer Übungsfahrt mit Prüfungscharakter 
  im Start-/Landebahnsystem.
 $endif$
@@ -124,9 +126,9 @@ $else$
 $endif$
 we require by **$expiry$**, that the 
 $if(practical)$
- theorectical and paractical
+ theorectical and practical
 $endif$
-airport-specific recurrent training at Fraport AG,
+airport-specific $qarea$ recurrent training at Fraport AG,
 according to European Union Regulation No. 139/2014,
 has been completed.
 
@@ -139,7 +141,7 @@ $if(supervisor)$
 Only you are authorized to hand over the personal login data to the training participant.
 $endif$
 
-The completion of the e-learning will require abut 1--2 hours.
+The completion of the e-learning will require abut ca. 2 hours.
 Results will be automatically transmitted to Fraport Driver Training.
 
 $if(practical)$
@@ -150,7 +152,7 @@ $if(practical)$
  your company must schedule you
  $endif$
  for the practical part of the training. 
- The 3--4 hour practical refresher includes radio exercises and 
+ The ca. 4 hour practical refresher includes radio exercises and 
  an examination-style test drive within the runway system.
 $endif$  
 

templates/qualification.hamlet

@@ -49,6 +49,13 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
         <p>
           #{icon IconNotificationError}
           _{MsgLmsErrorNoRefreshElearning}
+
+    <dt .deflist__dt>_{MsgQualificationElearningRenew}
+    <dd .deflist__dd>#{boolSymbol (qualificationElearningRenews quali)}
+      $if (qualificationElearningRenews quali) && isNothing (qualificationValidDuration quali)
+        <p>
+          #{icon IconNotificationError}
+          _{MsgLmsErrorNoRefreshElearning}
     
 <section>    
   ^{qualificationTable}

test/Database/Fill.hs

@@ -753,9 +753,9 @@ fillDb = do
   let r_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|]
   let l_descr = Just $ htmlToStoredMarkup [shamlet|<p>für unhabilitierte|]
 
-  qid_f  <- insert' $ Qualification avn "F" "Vorfeldführerschein"  f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) (Just $ CalendarDiffDays 0 14) True True  (Just AvsLicenceVorfeld)  $ Just "F4466"
+  qid_f  <- insert' $ Qualification avn "F" "Vorfeldführerschein"  f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) (Just $ CalendarDiffDays 0 14) True True True  (Just AvsLicenceVorfeld)  $ Just "F4466"
-  qid_r  <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3)  Nothing False False (Just AvsLicenceRollfeld) $ Just "R2801"
+  qid_r  <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3)  Nothing False False False (Just AvsLicenceRollfeld) $ Just "R2801"
-  qid_l  <- insert' $ Qualification ifi "L" "Lehrbefähigung"       l_descr Nothing   (Just 6) Nothing Nothing False True Nothing Nothing
+  qid_l  <- insert' $ Qualification ifi "L" "Lehrbefähigung"       l_descr Nothing   (Just 6) Nothing Nothing True False True Nothing Nothing
   qfjost <- insert' $ QualificationUser jost       qid_f (n_day  11) (n_day $   -1) (n_day $   -22) True (n_day' $ -9) -- TODO: better dates!
   void . insert  $ QualificationUserBlock qfjost False (n_day' $ -6) "First block"    (Just svaupel)
   void . insert  $ QualificationUserBlock qfjost True  (n_day' $ -5) "Second unblock" (Just gkleen)