Send both plain text and html in mail notifications

1 files changed, 14 insertions, 6 deletions

diff --git a/src/Mail.hs b/src/Mail.hs
index 45962a5..83a2bbd 100644
--- a/src/Mail.hs
+++ b/src/Mail.hs
@@ -5,8 +5,9 @@ module Mail
   ) where
 
 import Data.Text (Text)
-import Data.Text.Lazy.Builder (toLazyText, fromText)
 import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import Data.Text.Lazy.Builder (toLazyText, fromText)
 
 import Control.Exception (SomeException, try)
 
@@ -14,21 +15,28 @@ import Network.Mail.Mime
 
 import Utils.Either (mapLeft)
 
-sendMail :: [Text] -> Text -> Text -> IO (Either Text ())
-sendMail mailTo subject body = safeSendMail (mail mailTo subject body)
+sendMail :: [Text] -> Text -> Text -> Text -> IO (Either Text ())
+sendMail mailTo subject plainBody htmlBody = safeSendMail (mail mailTo subject plainBody htmlBody)
 
 safeSendMail :: Mail -> IO (Either Text ())
 safeSendMail mail =
   mapLeft (T.pack . show) <$> (try (renderSendMail mail) :: IO (Either SomeException ()))
 
-mail :: [Text] -> Text -> Text -> Mail
-mail mailTo subject body =
+mail :: [Text] -> Text -> Text -> Text -> Mail
+mail mailTo subject plainBody htmlBody =
   let fromMail = emptyMail (address "no-reply@leboncoin-listener.com")
   in  fromMail
         { mailTo = map address mailTo
-        , mailParts = [[plainPart (toLazyText . fromText $ body)]]
+        , mailParts =
+            [ [ plainPart . strictToLazy $ plainBody
+              , htmlPart . strictToLazy $ htmlBody
+              ]
+            ]
         , mailHeaders = [("Subject", subject)]
         }
 
+strictToLazy :: Text -> LT.Text
+strictToLazy = toLazyText . fromText
+
 address :: Text -> Address
 address mail = Address { addressName = Nothing, addressEmail = mail }