aboutsummaryrefslogtreecommitdiff
path: root/src/Mail.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Mail.hs')
-rw-r--r--src/Mail.hs51
1 files changed, 27 insertions, 24 deletions
diff --git a/src/Mail.hs b/src/Mail.hs
index 83a2bbd..bf1516e 100644
--- a/src/Mail.hs
+++ b/src/Mail.hs
@@ -1,42 +1,45 @@
{-# LANGUAGE OverloadedStrings #-}
module Mail
- ( sendMail
+ ( send
) where
import Data.Text (Text)
import qualified Data.Text as T
-import qualified Data.Text.Lazy as LT
-import Data.Text.Lazy.Builder (toLazyText, fromText)
+import Data.Either (isLeft)
import Control.Exception (SomeException, try)
+import Control.Arrow (left)
-import Network.Mail.Mime
+import qualified Network.Mail.Mime as Mime
-import Utils.Either (mapLeft)
+import Model.Mail (Mail)
+import qualified Model.Mail as Mail
-sendMail :: [Text] -> Text -> Text -> Text -> IO (Either Text ())
-sendMail mailTo subject plainBody htmlBody = safeSendMail (mail mailTo subject plainBody htmlBody)
+send :: Mail -> IO (Either Text ())
+send mail = do
+ result <- left (T.pack . show) <$> (try (Mime.renderSendMail . getMimeMail $ mail) :: IO (Either SomeException ()))
+ if isLeft result
+ then putStrLn ("Error sending the following email:" ++ (show mail))
+ else return ()
+ return result
-safeSendMail :: Mail -> IO (Either Text ())
-safeSendMail mail =
- mapLeft (T.pack . show) <$> (try (renderSendMail mail) :: IO (Either SomeException ()))
-
-mail :: [Text] -> Text -> Text -> Text -> Mail
-mail mailTo subject plainBody htmlBody =
- let fromMail = emptyMail (address "no-reply@leboncoin-listener.com")
+getMimeMail :: Mail -> Mime.Mail
+getMimeMail mail =
+ let fromMail = Mime.emptyMail . address . Mail.from $ mail
in fromMail
- { mailTo = map address mailTo
- , mailParts =
- [ [ plainPart . strictToLazy $ plainBody
- , htmlPart . strictToLazy $ htmlBody
+ { Mime.mailTo = map address . Mail.to $ mail
+ , Mime.mailParts =
+ [ [ Mime.plainPart . Mail.plainBody $ mail
+ , Mime.htmlPart . Mail.htmlBody $ mail
]
]
- , mailHeaders = [("Subject", subject)]
+ , Mime.mailHeaders = [("Subject", Mail.subject mail)]
}
-strictToLazy :: Text -> LT.Text
-strictToLazy = toLazyText . fromText
-
-address :: Text -> Address
-address mail = Address { addressName = Nothing, addressEmail = mail }
+address :: Text -> Mime.Address
+address addressEmail =
+ Mime.Address
+ { Mime.addressName = Nothing
+ , Mime.addressEmail = addressEmail
+ }