Cleanup
This commit is contained in:
parent
1beeea5aa6
commit
9040ff4d3d
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
31
src/Mail.hs
31
src/Mail.hs
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user