Cleanup
This commit is contained in:
parent
1beeea5aa6
commit
9040ff4d3d
@ -1323,7 +1323,7 @@ instance YesodMail UniWorX where
|
|||||||
mailSmtp act = do
|
mailSmtp act = do
|
||||||
pool <- maybe (throwM MailNotAvailable) return =<< getsYesod appSmtpPool
|
pool <- maybe (throwM MailNotAvailable) return =<< getsYesod appSmtpPool
|
||||||
withResource pool act
|
withResource pool act
|
||||||
defaultMailAction ls mail = mailT ls $ do
|
mailT ls mail = defMailT ls $ do
|
||||||
setMailObjectId
|
setMailObjectId
|
||||||
setDateCurrent
|
setDateCurrent
|
||||||
|
|
||||||
|
|||||||
@ -129,10 +129,10 @@ setSerializable = [executeQQ|SET TRANSACTION ISOLATION LEVEL SERIALIZABLE|]
|
|||||||
|
|
||||||
performJob :: Job -> WriterT (Last Bool) (HandlerT UniWorX IO) ()
|
performJob :: Job -> WriterT (Last Bool) (HandlerT UniWorX IO) ()
|
||||||
performJob JobSendNotification{ jNotification = NotificationSubmissionRated{..}, .. } = do
|
performJob JobSendNotification{ jNotification = NotificationSubmissionRated{..}, .. } = do
|
||||||
$logDebugS "Jobs" "NotificationSubmissionRated" -- FIXME
|
fail "NotificationSubmissionRated not implemented yet" -- TODO
|
||||||
performJob JobSendTestEmail{..} = do
|
performJob JobSendTestEmail{..} = do
|
||||||
$logInfoS "Jobs" $ "Sending test-email to " <> jEmail
|
$logInfoS "Jobs" $ "Sending test-email to " <> jEmail
|
||||||
defaultMailAction jLanguages $ do
|
mailT jLanguages $ do
|
||||||
_mailTo .= [Address Nothing jEmail]
|
_mailTo .= [Address Nothing jEmail]
|
||||||
setSubjectI MsgMailTestSubject
|
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
|
( -- * Structured MIME emails
|
||||||
module Network.Mail.Mime
|
module Network.Mail.Mime
|
||||||
-- * MailT
|
-- * MailT
|
||||||
, MailT, mailT
|
, MailT, defMailT
|
||||||
, MailSmtpData(..), MailLanguages(..)
|
, MailSmtpData(..), MailLanguages(..)
|
||||||
, MonadMail(..)
|
, MonadMail(..)
|
||||||
-- * YesodMail
|
-- * YesodMail
|
||||||
@ -99,6 +99,7 @@ import qualified Text.Hamlet as Shakespeare (Translate, Render)
|
|||||||
|
|
||||||
import Data.Aeson (Options(..))
|
import Data.Aeson (Options(..))
|
||||||
import Data.Aeson.TH
|
import Data.Aeson.TH
|
||||||
|
import Utils (MsgRendererS, getMsgRenderer)
|
||||||
import Utils.PathPiece (splitCamel)
|
import Utils.PathPiece (splitCamel)
|
||||||
|
|
||||||
|
|
||||||
@ -186,19 +187,19 @@ class YesodMail site where
|
|||||||
) => m VerpMode
|
) => m VerpMode
|
||||||
mailVerp = return VerpNone
|
mailVerp = return VerpNone
|
||||||
|
|
||||||
defaultMailAction :: ( MonadHandler m
|
mailT :: ( MonadHandler m
|
||||||
, HandlerSite m ~ site
|
, HandlerSite m ~ site
|
||||||
, MonadBaseControl IO m
|
, MonadBaseControl IO m
|
||||||
) => MailLanguages -> MailT m a -> m a
|
) => MailLanguages -> MailT m a -> m a
|
||||||
defaultMailAction = mailT
|
mailT = defMailT
|
||||||
|
|
||||||
mailT :: ( MonadHandler m
|
defMailT :: ( MonadHandler m
|
||||||
, YesodMail (HandlerSite m)
|
, YesodMail (HandlerSite m)
|
||||||
, MonadBaseControl IO m
|
, MonadBaseControl IO m
|
||||||
) => MailLanguages -- ^ Languages in priority order
|
) => MailLanguages -- ^ Languages in priority order
|
||||||
-> MailT m a
|
-> MailT m a
|
||||||
-> m a
|
-> m a
|
||||||
mailT ls (MailT mail) = do
|
defMailT ls (MailT mail) = do
|
||||||
fromAddress <- defaultFromAddress
|
fromAddress <- defaultFromAddress
|
||||||
(ret, mail, smtpData) <- runRWST mail ls (emptyMail fromAddress)
|
(ret, mail, smtpData) <- runRWST mail ls (emptyMail fromAddress)
|
||||||
mail' <- liftIO $ LBS.toStrict <$> renderMail' mail
|
mail' <- liftIO $ LBS.toStrict <$> renderMail' mail
|
||||||
@ -249,9 +250,9 @@ instance (ToMailPart site a, RenderMessage site msg) => ToMailPart site (Shakesp
|
|||||||
mr <- Yesod.getMessageRender
|
mr <- Yesod.getMessageRender
|
||||||
toMailPart $ act (toHtml . mr)
|
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
|
toMailPart act = do
|
||||||
mr <- Yesod.getMessageRender
|
mr <- getMsgRenderer
|
||||||
toMailPart $ act mr
|
toMailPart $ act mr
|
||||||
|
|
||||||
instance ToMailPart site a => ToMailPart site (Shakespeare.Render (Route site) -> a) where
|
instance ToMailPart site a => ToMailPart site (Shakespeare.Render (Route site) -> a) where
|
||||||
|
|||||||
Reference in New Issue
Block a user