feat: use pandoc to convert html emails to markdown (plaintext)

src/Handler/Utils/Mail.hs

@@ -3,9 +3,11 @@ module Handler.Utils.Mail
   , userAddress, userAddressFrom
   , userMailT
   , addFileDB
+  , addHtmlMarkdownAlternatives
   ) where
 
 import Import
+import Handler.Utils.Pandoc
 
 import qualified Data.CaseInsensitive as CI
 
@@ -17,6 +19,11 @@ import System.FilePath (takeBaseName)
 
 import Control.Monad.Trans.State (StateT)
 
+import qualified Text.Pandoc as P
+
+import qualified Text.Hamlet as Hamlet (Translate)
+import qualified Text.Shakespeare as Shakespeare (RenderUrl)
+
 
 addRecipientsDB :: ( MonadMail m
                    , HandlerSite m ~ UniWorX
@@ -75,3 +82,43 @@ addFileDB fId = runMaybeT $ do
     _partFilename .= Just fileName
     _partContent .= LBS.fromStrict fileContent
     setMailObjectIdCrypto fId :: StateT Part (HandlerFor UniWorX) MailObjectId
+
+
+class YesodMail site => ToMailHtml site a where
+  toMailHtml :: (MonadMail m, HandlerSite m ~ site) => a -> m Html
+
+instance YesodMail site => ToMailHtml site Html where
+  toMailHtml = return
+
+instance (ToMailHtml site a, RenderMessage site msg) => ToMailHtml site (Hamlet.Translate msg -> a) where
+  toMailHtml act = do
+    mr <- getMailMessageRender
+    toMailHtml $ act (toHtml . mr)
+
+instance (ToMailHtml site a, site ~ site') => ToMailHtml site (MsgRendererS site' -> a) where
+  toMailHtml act = do
+    mr <- getMailMsgRenderer
+    toMailHtml $ act mr
+
+instance ToMailHtml site a => ToMailHtml site (Shakespeare.RenderUrl (Route site) -> a) where
+  toMailHtml act = do
+    ur <- getUrlRenderParams
+    toMailHtml $ act ur
+
+
+addHtmlMarkdownAlternatives :: ( MonadMail m
+                               , ToMailPart (HandlerSite m) Html
+                               , ToMailHtml (HandlerSite m) a
+                               )
+                            => a -> m ()
+addHtmlMarkdownAlternatives html' = do
+  html <- toMailHtml html'
+  markdown <- runMaybeT $ renderMarkdownWith htmlReaderOptions writerOptions html
+
+  addAlternatives $ do
+    providePreferredAlternative html
+    whenIsJust markdown provideAlternative
+  where
+    writerOptions = markdownWriterOptions
+      { P.writerReferenceLinks = True
+      }

src/Handler/Utils/Pandoc.hs

@@ -1,5 +1,6 @@
 module Handler.Utils.Pandoc
   ( htmlField, htmlFieldSmall
+  , renderMarkdownWith, parseMarkdownWith
   , htmlReaderOptions, markdownReaderOptions
   , markdownWriterOptions, htmlWriterOptions
   ) where
@@ -42,17 +43,20 @@ htmlField' fieldKind = Field{..}
       let markdownExplanation = $(i18nWidgetFile "markdown-explanation")
       $(widgetFile "widgets/html-field")
 
-parseMarkdown :: Text -> Either (SomeMessage site) Html
+    parseMarkdown  = parseMarkdownWith  markdownReaderOptions htmlWriterOptions
-parseMarkdown text =
+    renderMarkdown = renderMarkdownWith htmlReaderOptions     markdownWriterOptions
+
+parseMarkdownWith :: P.ReaderOptions -> P.WriterOptions -> Text -> Either (SomeMessage site) Html
+parseMarkdownWith readerOptions writerOptions text =
   bimap pandocError (preEscapedText . sanitizeBalance) . P.runPure $
-    P.writeHtml5String htmlWriterOptions =<< P.readMarkdown markdownReaderOptions text
+    P.writeHtml5String writerOptions =<< P.readMarkdown readerOptions text
   where
     pandocError = SomeMessage . tshow
 
-renderMarkdown :: (MonadLogger m, MonadPlus m) => Html -> m Text
+renderMarkdownWith :: (MonadLogger m, MonadPlus m) => P.ReaderOptions -> P.WriterOptions -> Html -> m Text
-renderMarkdown html =
+renderMarkdownWith readerOptions writerOptions html =
   either (\e -> logPandocError e >> mzero) return . P.runPure $
-    P.writeMarkdown markdownWriterOptions =<< P.readHtml htmlReaderOptions (toStrict $ renderHtml html)
+    P.writeMarkdown writerOptions =<< P.readHtml readerOptions (toStrict $ renderHtml html)
   where
     logPandocError = $logErrorS "renderMarkdown" . tshow
 

src/Jobs/Handler/ChangeUserDisplayEmail.hs

@@ -25,5 +25,4 @@ dispatchJobChangeUserDisplayEmail jUser jDisplayEmail = do
     _mailTo .= pure (userAddress user & _addressEmail .~ CI.original jDisplayEmail)
     replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
     setSubjectI MsgMailSubjectChangeUserDisplayEmail
-    addAlternatives $
+    addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/changeUserDisplayEmail.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
-      providePreferredAlternative ($(ihamletFile "templates/mail/changeUserDisplayEmail.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))

src/Jobs/Handler/HelpRequest.hs

@@ -32,4 +32,4 @@ dispatchJobHelpRequest jSender jRequestTime jHelpSubject jHelpRequest jReferer =
     setSubjectI $ maybe MsgMailSubjectSupport MsgMailSubjectSupportCustom jHelpSubject
     setDate jRequestTime
     rtime <- formatTimeMail SelFormatDateTime jRequestTime
-    addPart ($(ihamletFile "templates/mail/support.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
+    addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/support.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))

src/Jobs/Handler/Invitation.hs

@@ -23,4 +23,4 @@ dispatchJobInvitation jInviter jInvitee jInvitationUrl jInvitationSubject jInvit
     replaceMailHeader "Reply-To" . Just . renderAddress $ userAddressFrom jInviter'
     replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
     replaceMailHeader "Subject" $ Just jInvitationSubject
-    addPart ($(ihamletFile "templates/mail/invitation.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
+    addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/invitation.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))

src/Jobs/Handler/SendCourseCommunication.hs

@@ -4,6 +4,8 @@ module Jobs.Handler.SendCourseCommunication
 
 import Import
 
+import Text.Hamlet
+
 import Handler.Utils
 
 import qualified Data.CaseInsensitive as CI
@@ -30,7 +32,7 @@ dispatchJobSendCourseCommunication jRecipientEmail jAllRecipientAddresses jCours
     addMailHeader "Cc" [st|#{mr MsgCommUndisclosedRecipients}:;|]
     addMailHeader "Auto-Submitted" "no"
     setSubjectI . prependCourseTitle courseTerm courseSchool courseShorthand $ maybe (SomeMessage MsgCommCourseSubject) SomeMessage jSubject
-    void $ addPart jMailContent
+    addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/courseCommunication.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
     when (jRecipientEmail == Right jSender) $
       addPart' $ do
         partIsAttachmentCsv $ mr MsgCommAllRecipients

src/Jobs/Handler/SendNotification/Allocation.hs

@@ -28,8 +28,7 @@ dispatchNotificationAllocationStaffRegister nAllocation jRecipient = userMailT j
   setSubjectI $ MsgMailSubjectAllocationStaffRegister allocationName
   editNotifications <- mkEditNotifications jRecipient
   registerDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffRegisterTo
-  addAlternatives $
+  addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationStaffRegister.hamlet")
-    providePreferredAlternative $(ihamletFile "templates/mail/allocationStaffRegister.hamlet")
 
 dispatchNotificationAllocationRegister :: AllocationId -> UserId -> Handler ()
 dispatchNotificationAllocationRegister nAllocation jRecipient = userMailT jRecipient $ do
@@ -39,8 +38,7 @@ dispatchNotificationAllocationRegister nAllocation jRecipient = userMailT jRecip
   setSubjectI $ MsgMailSubjectAllocationRegister allocationName
   editNotifications <- mkEditNotifications jRecipient
   registerDeadline <- traverse (formatTime SelFormatDateTime) allocationRegisterTo
-  addAlternatives $
+  addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationRegister.hamlet")
-    providePreferredAlternative $(ihamletFile "templates/mail/allocationRegister.hamlet")
 
 dispatchNotificationAllocationAllocation :: AllocationId -> UserId -> Handler ()
 dispatchNotificationAllocationAllocation nAllocation jRecipient = do
@@ -71,8 +69,7 @@ dispatchNotificationAllocationAllocation nAllocation jRecipient = do
     editNotifications <- mkEditNotifications jRecipient
     allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
     registerDeadline <- traverse (formatTime SelFormatDateTime) $ assertM (> now) allocationRegisterTo
-    addAlternatives $
+    addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationAllocation.hamlet")
-      providePreferredAlternative $(ihamletFile "templates/mail/allocationAllocation.hamlet")
 
 dispatchNotificationAllocationUnratedApplications :: AllocationId -> UserId -> Handler ()
 dispatchNotificationAllocationUnratedApplications nAllocation jRecipient = do
@@ -112,8 +109,7 @@ dispatchNotificationAllocationUnratedApplications nAllocation jRecipient = do
     setSubjectI $ MsgMailSubjectAllocationUnratedApplications allocationName
     editNotifications <- mkEditNotifications jRecipient
     allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
-    addAlternatives $
+    addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationUnratedApplications.hamlet")
-      providePreferredAlternative $(ihamletFile "templates/mail/allocationUnratedApplications.hamlet")
 
 dispatchNotificationAllocationOutdatedRatings :: AllocationId -> UserId -> Handler ()
 dispatchNotificationAllocationOutdatedRatings nAllocation jRecipient = do
@@ -153,8 +149,7 @@ dispatchNotificationAllocationOutdatedRatings nAllocation jRecipient = do
     setSubjectI $ MsgMailSubjectAllocationOutdatedRatings allocationName
     editNotifications <- mkEditNotifications jRecipient
     allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
-    addAlternatives $
+    addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationOutdatedRatings.hamlet")
-      providePreferredAlternative $(ihamletFile "templates/mail/allocationOutdatedRatings.hamlet")
 
 dispatchNotificationAllocationResults :: AllocationId -> UserId -> Handler ()
 dispatchNotificationAllocationResults nAllocation jRecipient = userMailT jRecipient $ do
@@ -200,5 +195,4 @@ dispatchNotificationAllocationResults nAllocation jRecipient = userMailT jRecipi
   setSubjectI $ MsgMailSubjectAllocationResults allocationName
   editNotifications <- mkEditNotifications jRecipient
   
-  addAlternatives $
+  addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationResults.hamlet")
-    providePreferredAlternative $(ihamletFile "templates/mail/allocationResults.hamlet")

src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs

@@ -31,5 +31,4 @@ dispatchNotificationCorrectionsAssigned  nUser nSheet jRecipient = do
 
     editNotifications <- mkEditNotifications jRecipient
 
-    addAlternatives $
+    addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/correctionsAssigned.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
-      providePreferredAlternative ($(ihamletFile "templates/mail/correctionsAssigned.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))

src/Jobs/Handler/SendNotification/CorrectionsNotDistributed.hs

@@ -28,5 +28,4 @@ dispatchNotificationCorrectionsNotDistributed nSheet jRecipient = do
         csh = courseShorthand
         shn = sheetName
 
-    addAlternatives $
+    addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/correctionsUndistributed.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
-      providePreferredAlternative ($(ihamletFile "templates/mail/correctionsUndistributed.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))

src/Jobs/Handler/SendNotification/CourseRegistered.hs

@@ -31,5 +31,4 @@ dispatchNotificationCourseRegistered nUser nCourse jRecipient = userMailT jRecip
 
   editNotifications <- mkEditNotifications jRecipient
 
-  addAlternatives $
+  addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/courseRegistered.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
-    providePreferredAlternative ($(ihamletFile "templates/mail/courseRegistered.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))

src/Jobs/Handler/SendNotification/ExamActive.hs

@@ -32,8 +32,7 @@ dispatchNotificationExamRegistrationActive nExam jRecipient = userMailT jRecipie
 
   editNotifications <- mkEditNotifications jRecipient
 
-  addAlternatives $
+  addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/examRegistrationActive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
-    providePreferredAlternative ($(ihamletFile "templates/mail/examRegistrationActive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
 
 dispatchNotificationExamRegistrationSoonInactive :: ExamId -> UserId -> Handler ()
 dispatchNotificationExamRegistrationSoonInactive nExam jRecipient = userMailT jRecipient $ do
@@ -53,8 +52,7 @@ dispatchNotificationExamRegistrationSoonInactive nExam jRecipient = userMailT jR
 
   editNotifications <- mkEditNotifications jRecipient
 
-  addAlternatives $
+  addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/examRegistrationSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
-    providePreferredAlternative ($(ihamletFile "templates/mail/examRegistrationSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
 
 dispatchNotificationExamDeregistrationSoonInactive :: ExamId -> UserId -> Handler ()
 dispatchNotificationExamDeregistrationSoonInactive nExam jRecipient = userMailT jRecipient $ do
@@ -74,5 +72,4 @@ dispatchNotificationExamDeregistrationSoonInactive nExam jRecipient = userMailT
 
   editNotifications <- mkEditNotifications jRecipient
 
-  addAlternatives $
+  addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/examDeregistrationSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
-    providePreferredAlternative ($(ihamletFile "templates/mail/examDeregistrationSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))

src/Jobs/Handler/SendNotification/ExamOffice.hs

@@ -35,8 +35,7 @@ dispatchNotificationExamOfficeExamResults nExam jRecipient = userMailT jRecipien
 
   editNotifications <- mkEditNotifications jRecipient
 
-  addAlternatives $
+  addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/examOffice/examResults.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
-    providePreferredAlternative ($(ihamletFile "templates/mail/examOffice/examResults.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
 
 dispatchNotificationExamOfficeExamResultsChanged :: Set ExamResultId -> UserId -> Handler ()
 dispatchNotificationExamOfficeExamResultsChanged nExamResults jRecipient = do
@@ -60,8 +59,7 @@ dispatchNotificationExamOfficeExamResultsChanged nExamResults jRecipient = do
 
     editNotifications <- mkEditNotifications jRecipient
 
-    addAlternatives $
+    addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/examOffice/examResultsChanged.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
-      providePreferredAlternative ($(ihamletFile "templates/mail/examOffice/examResultsChanged.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
 
 
 dispatchNotificationExamOfficeExternalExamResults :: ExternalExamId -> UserId -> Handler ()
@@ -79,5 +77,4 @@ dispatchNotificationExamOfficeExternalExamResults nExternalExam jRecipient = use
 
   editNotifications <- mkEditNotifications jRecipient
 
-  addAlternatives $
+  addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/examOffice/externalExamResults.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
-    providePreferredAlternative ($(ihamletFile "templates/mail/examOffice/externalExamResults.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))

src/Jobs/Handler/SendNotification/ExamResult.hs

@@ -30,5 +30,4 @@ dispatchNotificationExamResult nExam jRecipient = userMailT jRecipient $ do
 
   editNotifications <- mkEditNotifications jRecipient
 
-  addAlternatives $
+  addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/examResult.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
-    providePreferredAlternative ($(ihamletFile "templates/mail/examResult.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))

src/Jobs/Handler/SendNotification/SheetActive.hs

@@ -30,5 +30,4 @@ dispatchNotificationSheetActive nSheet jRecipient = userMailT jRecipient $ do
 
   editNotifications <- mkEditNotifications jRecipient
 
-  addAlternatives $
+  addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/sheetActive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
-    providePreferredAlternative ($(ihamletFile "templates/mail/sheetActive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))

src/Jobs/Handler/SendNotification/SheetInactive.hs

@@ -33,8 +33,7 @@ dispatchNotificationSheetSoonInactive nSheet jRecipient = userMailT jRecipient $
 
   editNotifications <- mkEditNotifications jRecipient
 
-  addAlternatives $
+  addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/sheetSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
-    providePreferredAlternative ($(ihamletFile "templates/mail/sheetSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
 
 dispatchNotificationSheetInactive :: SheetId -> UserId -> Handler ()
 dispatchNotificationSheetInactive nSheet jRecipient = userMailT jRecipient $ do
@@ -60,6 +59,5 @@ dispatchNotificationSheetInactive nSheet jRecipient = userMailT jRecipient $ do
 
   editNotifications <- mkEditNotifications jRecipient
 
-  addAlternatives $
+  addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/sheetInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
-    providePreferredAlternative ($(ihamletFile "templates/mail/sheetInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
 

src/Jobs/Handler/SendNotification/SubmissionEdited.hs

@@ -51,8 +51,7 @@ dispatchNotificationSubmissionEdited nInitiator nSubmission jRecipient = userMai
 
   editNotifications <- mkEditNotifications jRecipient
 
-  addAlternatives $
+  addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/submissionEdited.hamlet")
-    providePreferredAlternative $(ihamletFile "templates/mail/submissionEdited.hamlet")
 
 dispatchNotificationSubmissionUserCreated :: UserId -> SubmissionId -> UserId -> Handler ()
 dispatchNotificationSubmissionUserCreated nUser nSubmission jRecipient = userMailT jRecipient $ do
@@ -91,8 +90,7 @@ dispatchNotificationSubmissionUserCreated nUser nSubmission jRecipient = userMai
 
   editNotifications <- mkEditNotifications jRecipient
 
-  addAlternatives $
+  addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/submissionUserCreated.hamlet")
-    providePreferredAlternative $(ihamletFile "templates/mail/submissionUserCreated.hamlet")
   
 
 dispatchNotificationSubmissionUserDeleted :: UserId -> SheetId -> SubmissionId -> UserId -> Handler ()
@@ -134,5 +132,4 @@ dispatchNotificationSubmissionUserDeleted nUser nSheet nSubmission jRecipient =
 
   editNotifications <- mkEditNotifications jRecipient
 
-  addAlternatives $
+  addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/submissionUserDeleted.hamlet")
-    providePreferredAlternative $(ihamletFile "templates/mail/submissionUserDeleted.hamlet")

src/Jobs/Handler/SendNotification/SubmissionRated.hs

@@ -10,7 +10,6 @@ import Handler.Utils
 import Jobs.Handler.SendNotification.Utils
 
 import Text.Hamlet
-import qualified Data.Aeson as Aeson
 import qualified Data.CaseInsensitive as CI
 
 dispatchNotificationSubmissionRated :: SubmissionId -> UserId -> Handler ()
@@ -39,27 +38,4 @@ dispatchNotificationSubmissionRated nSubmission jRecipient = userMailT jRecipien
 
   editNotifications <- mkEditNotifications jRecipient
 
-  -- TODO: provide convienience template-haskell for `addAlternatives`
+  addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/submissionRated.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
-  addAlternatives $ do
-    provideAlternative $ Aeson.object
-      [ "submission" Aeson..= ciphertext csid
-      , "submission-rating-points" Aeson..= (guard (sheetType /= NotGraded) *> submissionRatingPoints)
-      , "submission-rating-comment" Aeson..= submissionRatingComment
-      , "submission-rating-time" Aeson..= submissionRatingTime
-      , (Aeson..=) "submission-rating-by" $ do
-          corrector' <- corrector
-          return $ Aeson.object
-            [ "display-name" Aeson..= userDisplayName corrector'
-            , "surname" Aeson..= userSurname corrector'
-            , "email" Aeson..= userEmail corrector'
-            ]
-      , "submission-rating-passed" Aeson..= join (gradingPassed <$> sheetType ^? _grading <*> submissionRatingPoints)      
-      , "sheet-name" Aeson..= sheetName
-      , "sheet-type" Aeson..= sheetType
-      , "course-name" Aeson..= courseName
-      , "course-shorthand" Aeson..= courseShorthand
-      , "course-term" Aeson..= courseTerm
-      , "course-school" Aeson..= courseSchool
-      ]
-    -- provideAlternative $ \(MsgRenderer mr) -> ($(textFile "templates/mail/submissionRated.txt") :: TextUrl (Route UniWorX)) -- textFile does not support control statements
-    providePreferredAlternative ($(ihamletFile "templates/mail/submissionRated.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))

src/Jobs/Handler/SendNotification/UserAuthModeUpdate.hs

@@ -22,6 +22,5 @@ dispatchNotificationUserAuthModeUpdate  nUser _nOriginalAuthMode jRecipient = us
 
     editNotifications <- ihamletSomeMessage <$> mkEditNotifications jRecipient
 
-    addAlternatives $
+    addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/userAuthModeUpdate.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX))
-      providePreferredAlternative ($(ihamletFile "templates/mail/userAuthModeUpdate.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX))
 

src/Jobs/Handler/SendNotification/UserRightsUpdate.hs

@@ -25,6 +25,5 @@ dispatchNotificationUserRightsUpdate  nUser _originalRights jRecipient = userMai
     setSubjectI $ MsgMailSubjectUserRightsUpdate userDisplayName
     -- MsgRenderer mr <- getMailMsgRenderer
     editNotifications <- mkEditNotifications jRecipient
-    addAlternatives $
+    addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/userRightsUpdate.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX))
-      providePreferredAlternative ($(ihamletFile "templates/mail/userRightsUpdate.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX))
 

src/Jobs/Handler/SendPasswordReset.hs

@@ -36,5 +36,4 @@ dispatchJobSendPasswordReset jRecipient = userMailT jRecipient $ do
 
   resetUrl <- toTextUrl (UserPasswordR cID, [(toPathPiece GetBearer, toPathPiece encodedToken)])
 
-  addAlternatives $
+  addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/passwordReset.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
-    providePreferredAlternative ($(ihamletFile "templates/mail/passwordReset.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))

src/Jobs/Handler/SendTestEmail.hs

@@ -4,10 +4,9 @@ module Jobs.Handler.SendTestEmail
 
 import Import 
 
+import Handler.Utils.Mail
 import Handler.Utils.DateTime
 
-import Text.Shakespeare.Text
-
 dispatchJobSendTestEmail :: Email -> MailContext -> Handler ()
 dispatchJobSendTestEmail jEmail jMailContext = mailT jMailContext $ do
   _mailTo .= [Address Nothing jEmail]
@@ -17,11 +16,14 @@ dispatchJobSendTestEmail jEmail jMailContext = mailT jMailContext $ do
   nDT <- formatTimeMail SelFormatDateTime now
   nD <- formatTimeMail SelFormatDate now
   nT <- formatTimeMail SelFormatTime now
-  addPart $ \(MsgRenderer mr) -> [text|
+  addHtmlMarkdownAlternatives $ \(MsgRenderer mr) -> [shamlet|
-    #{mr MsgMailTestContent}
+    <p>
+      #{mr MsgMailTestContent}
 
-    #{mr MsgMailTestDateTime}
+    <p>
-      * #{nDT}
+      #{mr MsgMailTestDateTime}
-      * #{nD}
+      <ul>
-      * #{nT}
+        <li>#{nDT}
-    |] :: TextUrl (Route UniWorX)
+        <li>#{nD}
+        <li>#{nT}
+    |]

templates/mail/courseCommunication.hamlet

@@ -0,0 +1,7 @@
+$newline never
+\<!doctype html>
+<html>
+  <head>
+    <meta charset="UTF-8">
+  <body>
+    #{jMailContent}