Add ouest france parser

1 files changed, 46 insertions, 0 deletions

diff --git a/src/executable/haskell/Service/MailService.hs b/src/executable/haskell/Service/MailService.hs
new file mode 100644
index 0000000..f6d9542
--- /dev/null
+++ b/src/executable/haskell/Service/MailService.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Service.MailService
+  ( send
+  ) where
+
+import           Control.Arrow          (left)
+import           Control.Exception      (SomeException, try)
+import           Data.Either            (isLeft)
+import           Data.Text              (Text)
+import qualified Data.Text              as T
+import qualified Data.Text.Lazy         as LT
+import           Data.Text.Lazy.Builder (fromText, toLazyText)
+import qualified Network.Mail.Mime      as Mime
+
+import           Model.Mail             (Mail)
+import qualified Model.Mail             as Mail
+
+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
+
+getMimeMail :: Mail -> Mime.Mail
+getMimeMail mail =
+  let fromMail = Mime.emptyMail . address . Mail.from $ mail
+  in  fromMail
+        { Mime.mailTo = map address . Mail.to $ mail
+        , Mime.mailParts =
+            [ [ Mime.plainPart . strictToLazy . Mail.plainBody $ mail ]
+            ]
+        , Mime.mailHeaders = [("Subject", Mail.subject mail)]
+        }
+
+address :: Text -> Mime.Address
+address addressEmail =
+  Mime.Address
+    { Mime.addressName = Nothing
+    , Mime.addressEmail = addressEmail
+    }
+
+strictToLazy :: Text -> LT.Text
+strictToLazy = toLazyText . fromText