This commit is contained in:
Gregor Kleen 2018-10-04 20:11:21 +02:00
parent 1beeea5aa6
commit 9040ff4d3d
3 changed files with 20 additions and 19 deletions

View File

@ -1323,7 +1323,7 @@ instance YesodMail UniWorX where
mailSmtp act = do
pool <- maybe (throwM MailNotAvailable) return =<< getsYesod appSmtpPool
withResource pool act
defaultMailAction ls mail = mailT ls $ do
mailT ls mail = defMailT ls $ do
setMailObjectId
setDateCurrent

View File

@ -129,10 +129,10 @@ setSerializable = [executeQQ|SET TRANSACTION ISOLATION LEVEL SERIALIZABLE|]
performJob :: Job -> WriterT (Last Bool) (HandlerT UniWorX IO) ()
performJob JobSendNotification{ jNotification = NotificationSubmissionRated{..}, .. } = do
$logDebugS "Jobs" "NotificationSubmissionRated" -- FIXME
fail "NotificationSubmissionRated not implemented yet" -- TODO
performJob JobSendTestEmail{..} = do
$logInfoS "Jobs" $ "Sending test-email to " <> jEmail
defaultMailAction jLanguages $ do
mailT jLanguages $ do
_mailTo .= [Address Nothing jEmail]
setSubjectI MsgMailTestSubject
addPart (($ MsgMailTestContent) :: (UniWorXMessage -> Text) -> Text) -- FIXME
addPart $ \(MsgRenderer mr) -> mr MsgMailTestContent

View File

@ -19,7 +19,7 @@ module Mail
( -- * Structured MIME emails
module Network.Mail.Mime
-- * MailT
, MailT, mailT
, MailT, defMailT
, MailSmtpData(..), MailLanguages(..)
, MonadMail(..)
-- * YesodMail
@ -99,6 +99,7 @@ import qualified Text.Hamlet as Shakespeare (Translate, Render)
import Data.Aeson (Options(..))
import Data.Aeson.TH
import Utils (MsgRendererS, getMsgRenderer)
import Utils.PathPiece (splitCamel)
@ -186,19 +187,19 @@ class YesodMail site where
) => m VerpMode
mailVerp = return VerpNone
defaultMailAction :: ( MonadHandler m
, HandlerSite m ~ site
, MonadBaseControl IO m
) => MailLanguages -> MailT m a -> m a
defaultMailAction = mailT
mailT :: ( MonadHandler m
, HandlerSite m ~ site
, MonadBaseControl IO m
) => MailLanguages -> MailT m a -> m a
mailT = defMailT
mailT :: ( MonadHandler m
, YesodMail (HandlerSite m)
, MonadBaseControl IO m
) => MailLanguages -- ^ Languages in priority order
-> MailT m a
-> m a
mailT ls (MailT mail) = do
defMailT :: ( MonadHandler m
, YesodMail (HandlerSite m)
, MonadBaseControl IO m
) => MailLanguages -- ^ Languages in priority order
-> MailT m a
-> m a
defMailT ls (MailT mail) = do
fromAddress <- defaultFromAddress
(ret, mail, smtpData) <- runRWST mail ls (emptyMail fromAddress)
mail' <- liftIO $ LBS.toStrict <$> renderMail' mail
@ -249,9 +250,9 @@ instance (ToMailPart site a, RenderMessage site msg) => ToMailPart site (Shakesp
mr <- Yesod.getMessageRender
toMailPart $ act (toHtml . mr)
instance (ToMailPart site a, RenderMessage site msg) => ToMailPart site ((msg -> Text) -> a) where
instance (ToMailPart site a, site ~ site') => ToMailPart site (MsgRendererS site' -> a) where
toMailPart act = do
mr <- Yesod.getMessageRender
mr <- getMsgRenderer
toMailPart $ act mr
instance ToMailPart site a => ToMailPart site (Shakespeare.Render (Route site) -> a) where