chore(lms): work on lms send notifications, work-in-progress

TODO.md

@@ -0,0 +1,15 @@
+# Incomplete Files 
+These files just contain 
+  - calls to error or 
+  - just consist of stubs or
+  - use misplaced placeholders from other sources
+and need to be finished.
+
+## Modules:
+  - Handler.Qualification
+  - Jobs.Handler.SendNotification.Qualification
+## Files:  
+  - templates/mail/qualificationExpiry.hamlet
+  - templates/i18n/qualification/renewal/de-de-formal.hamlet
+  - templates/i18n/qualification/renewal/en-eu.hamlet
+  

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

@@ -41,4 +41,6 @@ LmsResultUpdate: LMS Ergebnis aktualisierung
 LmsResultCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
 LmsUserlistCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
 LmsDirectUpload: Direkter Upload für automatisierte Systeme
-LmsErrorNoRefreshElearning: Fehler: E-Lernen wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde.
+LmsErrorNoRefreshElearning: Fehler: E-Lernen wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde.
+MailSubjectQualificationRenewal qname@Text: Ihre Qualifikation #{qname} muss demnächst erneuert werden
+MailSubjectQualificationExpiry qname@Text: Ihre Qualifikation #{qname} läuft demnächst ab

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

@@ -41,4 +41,6 @@ LmsResultUpdate: Update of LMS result
 LmsResultCsvExceptionDuplicatedKey: CSV import with ambiguous key
 LmsUserlistCsvExceptionDuplicatedKey: CSV import 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.
+MailSubjectQualificationRenewal qname@Text: Your qualification #{qname} must be renewed shortly
+MailSubjectQualificationExpiry qname@Text: Your qualification #{qname} expires soon

routes

@@ -254,16 +254,20 @@
 
 !/*WellKnownFileName WellKnownR GET !free
 
+-- for users 
+/qualification                                          QualificationAllR     GET       !free 
+/qualification/#SchoolId                                QualificationSchoolR  GET       !free
+/qualification/#SchoolId/#QualificationShorthand        QualificationR        GET       !free -- must be logged in though
 -- OSIS CSV Export Demo
-/lms                                                    LmsAllR             GET 
+/lms                                                    LmsAllR               GET 
-/lms/#SchoolId                                          LmsSchoolR          GET
+/lms/#SchoolId                                          LmsSchoolR            GET
-/lms/#SchoolId/#QualificationShorthand                  LmsR  				      GET POST
+/lms/#SchoolId/#QualificationShorthand                  LmsR  				        GET POST
-/lms/#SchoolId/#QualificationShorthand/edit             LmsEditR			      GET POST
+/lms/#SchoolId/#QualificationShorthand/edit             LmsEditR			        GET POST
-/lms/#SchoolId/#QualificationShorthand/users            LmsUsersR	          GET 
+/lms/#SchoolId/#QualificationShorthand/users            LmsUsersR	            GET 
-/lms/#SchoolId/#QualificationShorthand/users/direct     LmsUsersDirectR	    GET 
+/lms/#SchoolId/#QualificationShorthand/users/direct     LmsUsersDirectR	      GET 
-/lms/#SchoolId/#QualificationShorthand/userlist         LmsUserlistR	      GET POST
+/lms/#SchoolId/#QualificationShorthand/userlist         LmsUserlistR	        GET POST
-/lms/#SchoolId/#QualificationShorthand/userlist/upload  LmsUserlistUploadR	GET POST
+/lms/#SchoolId/#QualificationShorthand/userlist/upload  LmsUserlistUploadR	  GET POST
-/lms/#SchoolId/#QualificationShorthand/userlist/direct  LmsUserlistDirectR	    POST
+/lms/#SchoolId/#QualificationShorthand/userlist/direct  LmsUserlistDirectR	      POST
-/lms/#SchoolId/#QualificationShorthand/result           LmsResultR          GET POST
+/lms/#SchoolId/#QualificationShorthand/result           LmsResultR            GET POST
-/lms/#SchoolId/#QualificationShorthand/result/upload    LmsResultUploadR    GET POST
+/lms/#SchoolId/#QualificationShorthand/result/upload    LmsResultUploadR      GET POST
-/lms/#SchoolId/#QualificationShorthand/result/direct    LmsResultDirectR        POST
+/lms/#SchoolId/#QualificationShorthand/result/direct    LmsResultDirectR          POST

src/Foundation/Navigation.hs

@@ -133,7 +133,15 @@ breadcrumb HealthR          = i18nCrumb MsgMenuHealth          Nothing
 breadcrumb InstanceR        = i18nCrumb MsgMenuInstance        Nothing
 breadcrumb StatusR          = i18nCrumb MsgMenuHealth          Nothing  -- never displayed
 
-breadcrumb  LmsAllR                       = i18nCrumb MsgMenuQualifications Nothing
+breadcrumb  QualificationAllR                       = i18nCrumb MsgMenuQualifications Nothing
+breadcrumb (QualificationSchoolR          ssh     ) = useRunDB . maybeT (i18nCrumb MsgBreadcrumbSchool . Just $ SchoolListR) $ do -- redirect only, used in other breadcrumbs  
+  guardM . lift . existsBy . UniqueSchoolShorthand $ unSchoolKey ssh 
+  return (CI.original $ unSchoolKey ssh, Just QualificationAllR)
+breadcrumb (QualificationR                ssh  qsh) =useRunDB . maybeT (i18nCrumb MsgBreadcrumbCourse . Just $ QualificationSchoolR ssh) $ do
+  guardM . lift . existsBy $ SchoolQualificationShort ssh qsh 
+  return (CI.original qsh, Just $ QualificationSchoolR ssh)
+
+breadcrumb  LmsAllR                       = i18nCrumb MsgMenuLms Nothing
 breadcrumb (LmsSchoolR          ssh     ) = useRunDB . maybeT (i18nCrumb MsgBreadcrumbSchool . Just $ SchoolListR) $ do -- redirect only, used in other breadcrumbs  
   guardM . lift . existsBy . UniqueSchoolShorthand $ unSchoolKey ssh 
   return (CI.original $ unSchoolKey ssh, Just LmsAllR)

src/Handler/Qualification.hs

@@ -0,0 +1,248 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}      -- needed for HasEntity instances
+{-# OPTIONS -Wno-unused-top-binds #-}      -- TODO: remove me, for debugging only
+{-# LANGUAGE TypeApplications #-}
+
+module Handler.Qualification
+  ( getQualificationAllR
+  , getQualificationSchoolR
+  , getQualificationR
+  )
+  where
+
+import Import
+
+import Handler.Utils
+-- import Handler.Utils.Csv
+-- import Handler.Utils.LMS
+
+import qualified Data.Map as Map
+-- import qualified Data.Csv as Csv
+-- import qualified Data.Conduit.List as C
+import qualified Database.Esqueleto.Experimental as Ex -- needs TypeApplications Lang-Pragma
+import qualified Database.Esqueleto.Legacy as E
+import qualified Database.Esqueleto.Utils as E
+import Database.Esqueleto.Utils.TH
+
+
+-- avoids repetition of local definitions
+single :: (k,a) -> Map k a
+single = uncurry Map.singleton
+
+getQualificationSchoolR :: SchoolId -> Handler Html
+getQualificationSchoolR ssh = redirect (QualificationAllR, [("qualification-overview-school", toPathPiece ssh)])
+
+getQualificationAllR :: Handler Html
+getQualificationAllR = do -- TODO just a stub
+  lmsTable <- runDB $ do
+    view _2 <$> mkLmsAllTable  
+  siteLayoutMsg MsgMenuQualifications $ do
+    setTitleI MsgMenuQualifications
+    $(widgetFile "lms-all")
+
+type AllQualificationTableData = DBRow (Entity Qualification, Ex.Value Word64, Ex.Value Word64)
+resultAllQualification :: Lens' AllQualificationTableData Qualification
+resultAllQualification = _dbrOutput . _1 . _entityVal 
+
+resultAllQualificationActive :: Lens' AllQualificationTableData Word64
+resultAllQualificationActive = _dbrOutput . _2 . _unValue
+
+resultAllQualificationTotal  :: Lens' AllQualificationTableData Word64
+resultAllQualificationTotal  = _dbrOutput . _3 . _unValue
+
+
+mkLmsAllTable :: DB (Any, Widget)
+mkLmsAllTable = do 
+  now <- liftIO getCurrentTime
+  let    
+    resultDBTable = DBTable{..}
+      where
+        dbtSQLQuery quali = do         
+          cusers <- pure . Ex.subSelectCount $ do 
+            quser <- Ex.from $ Ex.table @QualificationUser
+            Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId                  
+          cactive <- pure . Ex.subSelectCount $ do 
+            quser <- Ex.from $ Ex.table @QualificationUser
+            Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId                  
+                  E.&&. quser Ex.^. QualificationUserValidUntil    Ex.>=. E.val (utctDay now)
+          -- Failed attempt using Join/GroupBy instead of subselect: see branch csv-osis-demo-groupby-problem 
+          return (quali, cactive, cusers)                          
+        dbtRowKey = (E.^. QualificationId)
+        dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference?
+        dbtColonnade = dbColonnade $ mconcat
+          [ colSchool $ resultAllQualification . _qualificationSchool
+          , sortable (Just "qshort")        (i18nCell MsgQualificationShort) $ \(view resultAllQualification -> quali) -> 
+              let qsh = qualificationShorthand quali in 
+              anchorCell (LmsR (qualificationSchool quali) qsh) $ toWgt qsh
+          , sortable (Just "qname")         (i18nCell MsgQualificationName)  $ \(view resultAllQualification -> quali) -> 
+              let qsh = qualificationShorthand quali
+                  qnm = qualificationName quali 
+              in anchorCell (LmsR (qualificationSchool quali) qsh) $ toWgt qnm
+          , sortable Nothing (i18nCell MsgQualificationDescription) $ \(view resultAllQualification -> quali) ->
+              maybeCell (qualificationDescription quali) markupCellLargeModal
+          , sortable Nothing (i18nCell MsgQualificationValidDuration & cellTooltip MsgTableDiffDaysTooltip) $ 
+              foldMap (textCell . formatCalendarDiffDays . fromMonths) . view (resultAllQualification . _qualificationValidDuration)
+          , sortable Nothing (i18nCell MsgQualificationRefreshWithin & cellTooltip MsgTableDiffDaysTooltip) $
+              foldMap (textCell . formatCalendarDiffDays             ) . view (resultAllQualification . _qualificationRefreshWithin)          
+          -- , sortable Nothing (i18nCell MsgQualificationRefreshWithin)   $ foldMap textCell . view (resultAllQualification . _qualificationRefreshWithin . to formatCalendarDiffDays) -- does not work, since there is a maybe in between
+          , sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart) 
+                                                                        $ tickmarkCell . view (resultAllQualification . _qualificationElearningStart)
+          , sortable Nothing (i18nCell MsgTableQualificationCountActive & cellTooltip MsgTableQualificationCountActiveTooltip) 
+                                                                        $ \(view resultAllQualificationActive -> n) -> wgtCell $ word2widget n
+          , sortable Nothing (i18nCell MsgTableQualificationCountTotal) $ wgtCell . word2widget . view resultAllQualificationTotal
+                                                                       -- \(view resultAllQualificationTotal  -> n) -> wgtCell $ word2widget n
+          ] 
+        dbtSorting = mconcat
+          [
+            sortSchool $ to (E.^. QualificationSchool)
+          , singletonMap "qshort"       $ SortColumn (E.^. QualificationShorthand)
+          , singletonMap "qname"        $ SortColumn (E.^. QualificationName)
+          , singletonMap "qelearning"   $ SortColumn (E.^. QualificationElearningStart)
+          ]
+        dbtFilter = mconcat
+          [
+            fltrSchool $ to (E.^. QualificationSchool)
+          , singletonMap "qelearning"   . FilterColumn $ E.mkExactFilterLast (E.^. QualificationElearningStart)
+          ]
+        dbtFilterUI = mconcat
+          [
+            fltrSchoolUI
+          , \mPrev -> prismAForm (singletonFilter "qelearning"   . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableLmsElearning)
+          ]
+        dbtStyle =  def { dbsFilterLayout = defaultDBSFilterLayout }
+        dbtParams = def
+        dbtIdent :: Text
+        dbtIdent = "qualification-overview"        
+        dbtCsvEncode = noCsvEncode
+        dbtCsvDecode = Nothing
+        dbtExtraReps = []
+
+    resultDBTableValidator = def
+      & defaultSorting [SortAscBy "school", SortAscBy "qshort"]
+  dbTable resultDBTableValidator resultDBTable
+
+
+
+getQualificationEditR,  postQualificationEditR :: SchoolId -> QualificationShorthand -> Handler Html
+getQualificationEditR = postQualificationEditR 
+postQualificationEditR = error "TODO"
+
+
+type LmsTableExpr = (                   E.SqlExpr (Entity QualificationUser)
+                      `E.InnerJoin`     E.SqlExpr (Entity User)
+                    ) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity LmsUser))
+
+queryQualUser :: LmsTableExpr -> E.SqlExpr (Entity QualificationUser)
+queryQualUser = $(sqlIJproj 2 1) . $(sqlLOJproj 2 1)
+
+queryUser :: LmsTableExpr -> E.SqlExpr (Entity User)
+queryUser = $(sqlIJproj 2 2) . $(sqlLOJproj 2 1)
+
+queryLmsUser :: LmsTableExpr -> E.SqlExpr (Maybe (Entity LmsUser))
+queryLmsUser = $(sqlLOJproj 2 2)
+
+type LmsTableData = DBRow (Entity QualificationUser, Entity User, Maybe (Entity LmsUser))
+
+resultQualUser :: Lens' LmsTableData (Entity QualificationUser)
+resultQualUser = _dbrOutput . _1
+
+resultUser :: Lens' LmsTableData (Entity User)
+resultUser = _dbrOutput . _2
+
+resultLmsUser :: Traversal' LmsTableData (Entity LmsUser)
+resultLmsUser = _dbrOutput . _3 . _Just
+
+instance HasEntity LmsTableData User where 
+  hasEntity = resultUser  
+
+instance HasUser LmsTableData where
+  hasUser = resultUser . _entityVal
+
+mkLmsTable :: Entity Qualification -> DB (Any, Widget)
+mkLmsTable (Entity qid quali) = do    
+  now <- liftIO getCurrentTime
+  let
+    nowaday = utctDay now
+    mbRenewal = addGregorianDurationClip <$> qualificationRefreshWithin quali <*> Just nowaday 
+    resultDBTable = DBTable{..}
+      where
+        dbtSQLQuery = runReaderT $ do
+          qualUser  <- asks queryQualUser
+          user      <- asks queryUser
+          lmsUser   <- asks queryLmsUser
+          lift $ do
+            E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser
+            E.on $ user E.^. UserId E.=?. lmsUser  E.?. LmsUserUser
+                    E.&&. E.val qid E.=?. lmsUser  E.?. LmsUserQualification   
+            E.where_ $    E.val qid E.==. qualUser E.^. QualificationUserQualification                                  
+          return (qualUser, user, lmsUser)
+        dbtRowKey = queryUser >>> (E.^. UserId)
+        dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference?
+        dbtColonnade = dbColonnade $ mconcat
+          [ colUserNameLinkHdr MsgTableLmsUser AdminUserR
+          , colUserEmail          
+          , sortable (Just "valid-until")   (i18nCell MsgTableQualificationValidUntil) $ \(   view $ resultQualUser . _entityVal . _qualificationUserValidUntil  -> d)  -> dayCell d
+          , sortable (Just "last-refresh")  (i18nCell MsgTableQualificationLastRefresh)$ \(   view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d)  -> dayCell d
+          , sortable (Just "first-held")    (i18nCell MsgTableQualificationFirstHeld)  $ \(   view $ resultQualUser . _entityVal . _qualificationUserFirstHeld   -> d)  -> dayCell d
+          , sortable (Just "lms-ident")     (i18nLms MsgTableLmsIdent)    $ \(preview $ resultLmsUser  . _entityVal . _lmsUserIdent . _getLmsIdent -> lid) -> foldMap textCell lid
+          , sortable (Just "lms-status")    (i18nLms MsgTableLmsStatus)   $ \(preview $ resultLmsUser  . _entityVal . _lmsUserStatus -> status)            -> foldMap lmsStatusCell $ join status
+          , sortable (Just "lms-started")   (i18nLms MsgTableLmsStarted)  $ \(preview $ resultLmsUser  . _entityVal . _lmsUserStarted  -> d) -> foldMap dateTimeCell        d
+          , sortable (Just "lms-received")  (i18nLms MsgTableLmsReceived) $ \(preview $ resultLmsUser  . _entityVal . _lmsUserReceived -> d) -> foldMap dateTimeCell $ join d 
+          , sortable (Just "lms-ended")     (i18nLms MsgTableLmsEnded)    $ \(preview $ resultLmsUser  . _entityVal . _lmsUserEnded    -> d) -> foldMap dateTimeCell $ join d
+          ] 
+          where 
+            i18nLms :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a
+            i18nLms msg = cell [whamlet|LMS #|] <> i18nCell msg
+        dbtSorting = mconcat
+          [ single $ sortUserNameLink queryUser
+          , single $ sortUserEmail    queryUser 
+          , single ("valid-until" , SortColumn $ queryQualUser >>> (E.^. QualificationUserValidUntil))
+          , single ("last-refresh", SortColumn $ queryQualUser >>> (E.^. QualificationUserLastRefresh))
+          , single ("first-held"  , SortColumn $ queryQualUser >>> (E.^. QualificationUserFirstHeld))                    
+          , single ("lms-ident"   , SortColumn $ queryLmsUser  >>> (E.?. LmsUserIdent))
+          , single ("lms-status"  , SortColumn $ views (to queryLmsUser) (E.?. LmsUserStatus))
+          , single ("lms-started" , SortColumn $ queryLmsUser  >>> (E.?. LmsUserStarted))
+          , single ("lms-received", SortColumn $ queryLmsUser  >>> (E.?. LmsUserReceived))
+          , single ("lms-ended"   , SortColumn $ queryLmsUser  >>> (E.?. LmsUserEnded))
+          ]          
+        dbtFilter = mconcat
+          [ single $ fltrUserNameEmail   queryUser
+          , single ("lms-ident"   , FilterColumn . E.mkContainsFilterWith (Just . LmsIdent) $ views (to queryLmsUser) (E.?. LmsUserIdent))
+          -- , single ("lms-status"  , FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) ((E.>=. E.val nowaday) . (E.^. LmsUserStatus))) -- LmsStatus cannot be filtered easily within the DB
+          , single ("validity"    , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) ((E.>=. E.val nowaday) . (E.^. QualificationUserValidUntil)))
+          , single ("renewal-due" , FilterColumn $ \(view (to queryQualUser) -> quser) criterion ->
+              if | Just renewal <- mbRenewal
+                 , Just True <- getLast criterion -> quser E.^. QualificationUserValidUntil E.<=. E.val renewal
+                                              E.&&.  quser E.^. QualificationUserValidUntil E.>=. E.val nowaday
+                 | otherwise -> E.true
+            )
+          ]          
+        dbtFilterUI mPrev = mconcat 
+          [ fltrUserNameEmailHdrUI MsgTableLmsUser mPrev
+          , prismAForm (singletonFilter "lms-ident"   . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent)          
+          -- , prismAForm (singletonFilter "lms-status"  . maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgTableNoFilter) $ return (optionsPairs [(MsgTableLmsSuccess,"success"::Text),(MsgTableLmsFailed,"blocked")])) (fslI MsgTableLmsStatus)
+          , prismAForm (singletonFilter "validity"    . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid)
+          , if isNothing mbRenewal then mempty
+            else prismAForm (singletonFilter "renewal-due" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgFilterLmsRenewal)
+          ]
+        dbtStyle =  def { dbsFilterLayout = defaultDBSFilterLayout }
+        dbtParams = def
+        dbtIdent :: Text
+        dbtIdent = "qualification"        
+        dbtCsvEncode = noCsvEncode
+        dbtCsvDecode = Nothing
+        dbtExtraReps = []
+
+    resultDBTableValidator = def
+      -- & defaultSorting [SortAscBy csvLmsIdent]
+  dbTable resultDBTableValidator resultDBTable
+
+getQualificationR :: SchoolId -> QualificationShorthand -> Handler Html
+getQualificationR sid qsh = do -- TODO just a copied stub
+  (lmsTable, quali) <- runDB $ do 
+    qent@(Entity _qid quali) <- getBy404 $ SchoolQualificationShort sid qsh 
+    tbl <- view _2 <$> mkLmsTable qent
+    return (tbl, quali)
+  let heading = citext2widget $ qualificationName quali
+  siteLayout heading $ do
+    setTitle $ toHtml $ unSchoolKey sid <> "-" <> qsh
+    $(widgetFile "lms")

src/Handler/Utils/I18n.hs

@@ -58,7 +58,7 @@ i18nWidgetFile :: FilePath -> Q Exp
 i18nWidgetFile = i18nFile widgetFile
 
 i18nHamletFile :: FilePath -> Q Exp
-i18nHamletFile basename = [e|$(i18nFile (hamletFile . (<.> "hamlet")) basename) <$> getUrlRenderParams|]
+i18nHamletFile basename = [e|$(i18nFile (hamletFile . ("templates" </>) . (<.> "hamlet")) basename) <$> getUrlRenderParams|]
 
 i18nWidgetFiles :: FilePath -> Q Exp
 i18nWidgetFiles basename = do

src/Jobs/Handler/SendNotification/Qualification.hs

@@ -7,43 +7,45 @@ module Jobs.Handler.SendNotification.Qualification
 
 import Import
 
-{-
+
 import Handler.Utils
 import Jobs.Handler.SendNotification.Utils
 
-import Handler.Info (FAQItem(..))
+-- import Handler.Info (FAQItem(..))
-
+import qualified Data.CaseInsensitive as CI
 import Text.Hamlet
 
-import qualified Database.Esqueleto.Experimental as E
+-- import qualified Database.Esqueleto.Experimental as E
-import qualified Database.Esqueleto.Utils as E
+-- import qualified Database.Esqueleto.Utils as E
--}
+
 
 dispatchNotificationQualificationExpiry :: QualificationId -> Day -> UserId -> Handler ()
-dispatchNotificationQualificationExpiry _nQualification _nExpiry _jRecipient = 
+dispatchNotificationQualificationExpiry nQualification _nExpiry jRecipient = userMailT jRecipient $ do
-  error "dispatchNotificationQualificationExpiry not yet implemented TODO"
+  (User{..}, Qualification{..}, Entity _ QualificationUser{..}) <- liftHandler . runDB $ (,,)
-{-  userMailT jRecipient $ do
+    <$> getJust jRecipient
-  (Allocation{..}, Course{..}, hasApplied) <- liftHandler . runDB $ (,,)
+    <*> getJust nQualification
-    <$> getJust nAllocation
+    <*> getJustBy (UniqueQualificationUser nQualification jRecipient)
-    <*> getJust nCourse
-    <*> exists [CourseApplicationAllocation ==. Just nAllocation, CourseApplicationUser ==. jRecipient]
 
+  let qname = CI.original qualificationName
   replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
-  setSubjectI $ MsgMailSubjectAllocationNewCourse allocationName
+  setSubjectI $ MsgMailSubjectQualificationExpiry qname
+  
   editNotifications <- mkEditNotifications jRecipient
 
-  cID <- encrypt nCourse
+  addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationExpiry.hamlet")
-  mayApply <- lift $ orM
-    [ is _Authorized <$> evalAccessFor (Just jRecipient) (AllocationR allocationTerm allocationSchool allocationShorthand ARegisterR) True
-    , is _Authorized <$> evalAccessFor (Just jRecipient) (AllocationR allocationTerm allocationSchool allocationShorthand $ AApplyR cID) True
-    ]
 
-  allocUrl <- toTextUrl $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR :#: cID
-
-  addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationNewCourse.hamlet")
--} 
 
 dispatchNotificationQualificationRenewal :: QualificationId -> UserId -> Handler ()
-dispatchNotificationQualificationRenewal _nQualification _jRecipient = 
+dispatchNotificationQualificationRenewal nQualification jRecipient = userMailT jRecipient $ do
-  error "dispatchNotificationQualificationRenewal not yet implemented TODO"
+  (User{..}, Qualification{..}, Entity _ QualificationUser{..}) <- liftHandler . runDB $ (,,)
-  -- userMailT jRecipient $ do
+    <$> getJust jRecipient
+    <*> getJust nQualification
+    <*> getJustBy (UniqueQualificationUser nQualification jRecipient)
+
+  let qname = CI.original qualificationName
+  replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
+  setSubjectI $ MsgMailSubjectQualificationRenewal qname
+  
+  -- editNotifications <- mkEditNotifications jRecipient -- TODO: add to hamlet file again
+  addHtmlMarkdownAlternatives $(i18nHamletFile "qualification/renewal")
+  

src/Settings.hs

@@ -747,6 +747,11 @@ widgetFile
   = widgetFileNoReload widgetFileSettings
 #endif
 
+-- Since widgetFile above also add "templates" directory, requires import Text.Hamlet (hamletFile)
+-- hamletFile' :: FilePath -> Q Exp
+-- hamletFile' nameBase = hamletFile $ "templates" </> nameBase
+
+
 -- | Raw bytes at compile time of @config/settings.yml@
 configSettingsYmlBS :: ByteString
 configSettingsYmlBS = $(embedFile configSettingsYml)

templates/i18n/qualification/renewal/de-de-formal.hamlet

@@ -0,0 +1,27 @@
+$newline never
+\<!doctype html>
+<html>
+  <head>
+    <meta charset="UTF-8">
+    <style>
+      h1 {
+        font-size: 1.25em;
+        font-variant: small-caps;
+        font-weight: normal;
+      }
+  <body>
+    <h1>
+      Qualifikation #{qualificationName} muss demnächst erneuert werden      
+
+    <p>
+      Ihre Qualifikation #{qualificationName} muss demnächst
+      erneuert werden
+      <br />
+      <a href=@{QualificationR qualificationSchool qualificationShorthand}>
+        #{qualificationName}
+
+      #{nameHtml userDisplayName userSurname}
+      #{show qualificationUserValidUntil}
+      #{show qualificationUserFirstHeld}
+
+      ihamletSomeMessage editNotifications

templates/i18n/qualification/renewal/en-eu.hamlet

@@ -0,0 +1,27 @@
+$newline never
+\<!doctype html>
+<html>
+  <head>
+    <meta charset="UTF-8">
+    <style>
+      h1 {
+        font-size: 1.25em;
+        font-variant: small-caps;
+        font-weight: normal;
+      }
+  <body>
+    <h1>
+      Qualification #{qualificationName} must be renewed shortly
+
+    <p>
+      Your Qualification #{qualificationName} is about to expire.
+      You may renew it to keep it:
+      <br />
+      <a href=@{QualificationR qualificationSchool qualificationShorthand}>
+        #{qualificationName}
+
+      #{nameHtml userDisplayName userSurname}
+      #{show qualificationUserValidUntil}
+      #{show qualificationUserFirstHeld}
+
+      ihamletSomeMessage editNotifications

templates/mail/qualificationExpiry.hamlet

@@ -0,0 +1,26 @@
+$newline never
+\<!doctype html>
+<html>
+  <head>
+    <meta charset="UTF-8">
+    <style>
+      h1 {
+        font-size: 1.25em;
+        font-variant: small-caps;
+        font-weight: normal;
+      }
+  <body>
+    <h1>
+      _{SomeMessage $ MsgMailSubjectQualificationExpiry qname}
+
+    <p>
+      _{SomeMessage MsgMailAllocationNewCourseTip}
+      <br />
+      <a href=@{QualificationR qualificationSchool qualificationShorthand}>
+        #{qualificationName}
+
+      #{nameHtml userDisplayName userSurname}
+      #{show qualificationUserValidUntil}
+      #{show qualificationUserFirstHeld}
+
+    ^{ihamletSomeMessage editNotifications}