diff --git a/src/Handler/Utils/Mail.hs b/src/Handler/Utils/Mail.hs index d48ecdfa0..810d6e095 100644 --- a/src/Handler/Utils/Mail.hs +++ b/src/Handler/Utils/Mail.hs @@ -14,7 +14,7 @@ module Handler.Utils.Mail import Import import Handler.Utils.Pandoc import Handler.Utils.Files -import Handler.Utils.Widgets (nameHtml') +import Handler.Utils.Widgets (nameHtml') -- TODO: how to use name widget here? import qualified Data.CaseInsensitive as CI @@ -22,9 +22,8 @@ import qualified Data.Conduit.Combinators as C import qualified Text.Pandoc as P -import qualified Text.Hamlet as Hamlet (Translate) +import qualified Text.Hamlet as Hamlet import qualified Text.Shakespeare as Shakespeare (RenderUrl) -import qualified Text.CI as CI addRecipientsDB :: ( MonadMail m @@ -56,42 +55,43 @@ userMailT :: ( MonadHandler m , MonadUnliftIO m ) => UserId -> MailT m () -> m () userMailT uid mAct = do - -- now <- liftIO getCurrentTime - underling <- liftHandler . runDB $ getJust uid - superVs <- liftHandler . runDB $ selectList [UserSupervisorUser ==. uid, UserSupervisorRerouteNotifications ==. True] [] - let receivers = if null superVs - then [uid] - else userSupervisorSupervisor . entityVal <$> superVs - undercopy = uid `elem` receivers + (underling, receivers) <- liftHandler . runDB $ do + underling <- getJustEntity uid + superVs <- selectList [UserSupervisorUser ==. uid, UserSupervisorRerouteNotifications ==. True] [] + let superIds = userSupervisorSupervisor . entityVal <$> superVs + supers <- if null superIds then pure [underling] else selectList [UserId <-. superIds] [] + return (underling, if null supers then [underling] else supers) + let undercopy = uid `elem` (entityKey <$> receivers) undername = underling ^. _userDisplayName -- nameHtml' underling undermail = CI.original $ underling ^. _userEmail - infoSupervised = \(MsgRenderer mr) -> [shamlet| -
- #{mr MsgMailSupervisedBody} + _{MsgMailSupervisedBody}
_{MsgMailSupervisorBody undername supername} # diff --git a/src/Jobs/Handler/SendTestEmail.hs b/src/Jobs/Handler/SendTestEmail.hs index 07205c1cb..5c84df9e8 100644 --- a/src/Jobs/Handler/SendTestEmail.hs +++ b/src/Jobs/Handler/SendTestEmail.hs @@ -36,10 +36,9 @@ dispatchJobSendTestEmail jEmail jMailContext = JobHandlerException . mailT jMail addHtmlMarkdownAlternatives' "part2" $ \(MsgRenderer _mr) -> [shamlet|
- Please ignore this part of the message send by
-
- FRADrive
+ Please ignore this part of the message.
|]
+ -- Compiles as well: let trdmsg :: HtmlUrlI18n _ (Route UniWorX) = [ihamlet|
let trdmsg :: HtmlUrlI18n UniWorXJobsHandlerMessage (Route UniWorX) = [ihamlet|
@@ -48,6 +47,10 @@ dispatchJobSendTestEmail jEmail jMailContext = JobHandlerException . mailT jMail
+ Message was sent to you by
+
+ FRADrive
|]
addHtmlMarkdownAlternatives' "part3" trdmsg
-- let test = $(i18nHamletFile "test")
Third part, again only for tests