From d3dd0e129658e3617f9e6e4fa0910cb15c42520d Mon Sep 17 00:00:00 2001
From: Joris Guyonvarch
Date: Tue, 14 Apr 2015 00:10:21 +0200
Subject: Send mail to notify for new ads

---
 src/AdListener.hs   | 28 ++++++++++++++++++++++++++--
 src/Config.hs       | 25 +++++++++++++++++++------
 src/Mail.hs         | 21 +++++++++++++++++++++
 src/Page.hs         |  6 ++----
 src/Utils/Either.hs |  7 +++++++
 5 files changed, 75 insertions(+), 12 deletions(-)
 create mode 100644 src/Mail.hs
 create mode 100644 src/Utils/Either.hs

(limited to 'src')

diff --git a/src/AdListener.hs b/src/AdListener.hs
index 21775cc..da3051d 100644
--- a/src/AdListener.hs
+++ b/src/AdListener.hs
@@ -22,6 +22,8 @@ import View.Ad (renderAds)
 import Page
 import Parser.Detail
 
+import Mail (sendMail)
+
 import Config (Config)
 import qualified Config as C
 
@@ -35,7 +37,9 @@ listenToNewAds config = do
       listenError config [] error
     Right resumes ->
       let newURLs = map url resumes
-      in  listenToNewAdsWithViewedURLs config newURLs
+      in  do
+            putStrLn "Listening for new ads…"
+            listenToNewAdsWithViewedURLs config newURLs
 
 listenToNewAdsWithViewedURLs :: Config -> [URL] -> IO ()
 listenToNewAdsWithViewedURLs config viewedURLs = do
@@ -59,12 +63,32 @@ listenToNewAdsWithResumes config viewedURLs resumes =
               time <- getCurrentFormattedTime
               if not (null newAds)
                 then
-                  T.putStrLn (newAdsMessage time newAds)
+                  let message = newAdsMessage time newAds
+                  in  do
+                        T.putStrLn message
+                        trySendMail config message
                 else
                   return ()
               waitOneMinute
               listenToNewAdsWithViewedURLs config (viewedURLs ++ newURLs)
 
+trySendMail :: Config -> Text -> IO ()
+trySendMail config message =
+  case C.mailTo config of
+    Just mailTo ->
+      do
+        eitherMailSuccess <- sendMail mailTo message
+        case eitherMailSuccess of
+          Right () ->
+            return "Mail sent."
+          Left error ->
+            T.putStrLn . T.concat $
+              [ "Error sending mail: "
+              , error
+              ]
+    Nothing ->
+      return ()
+
 newAdsMessage :: Text -> [Ad] -> Text
 newAdsMessage time newAds =
   let newAdsMessage =
diff --git a/src/Config.hs b/src/Config.hs
index 7a44ec0..88eeb1b 100644
--- a/src/Config.hs
+++ b/src/Config.hs
@@ -23,13 +23,24 @@ import Utils.Text
 
 configUsage :: Text
 configUsage =
-  T.intercalate
-    "\n"
-    [ T.concat
-        [ "Please provide an url for leboncoin in the file named: "
+  T.intercalate "\n"
+    [ ""
+    , T.concat
+        [ "  Some information is required in the file `"
         , T.pack configPath
+        , "`:"
         ]
-    , "url = http://…"
+    , ""
+    , "    - url (required)"
+    , "    - mailTo (optional)"
+    , ""
+    , "  Example:"
+    , ""
+    , "    # The url field is required"
+    , "    url = http://www.leboncoin.fr/locations/offres/ile_de_france/?f=a&th=1"
+    , ""
+    , "    # The mailTo field is an optional list"
+    , "    # mailTo = jean.dupont@mail.fr, john.smith@mail.com"
     ]
 
 configPath :: FilePath
@@ -37,6 +48,7 @@ configPath = "conf"
 
 data Config = Config
   { url :: URL
+  , mailTo :: Maybe [Text]
   } deriving (Eq, Read, Show)
 
 getConfig :: IO (Maybe Config)
@@ -62,7 +74,8 @@ configFromFile =
 configFromMap :: Map Text Text -> Maybe Config
 configFromMap map = do
   url <- M.lookup "url" map
-  return $ Config { url = url }
+  let mailTo = T.splitOn "," <$> M.lookup "mailTo" map
+  return $ Config { url = url, mailTo = mailTo }
 
 lineConfig :: Text -> Maybe (Text, Text)
 lineConfig line = do
diff --git a/src/Mail.hs b/src/Mail.hs
new file mode 100644
index 0000000..bb96142
--- /dev/null
+++ b/src/Mail.hs
@@ -0,0 +1,21 @@
+module Mail
+  ( sendMail
+  ) where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+
+import Control.Exception (SomeException, try)
+
+import Network.Email.Sendmail (sendmail)
+
+import Utils.Either (mapLeft)
+
+sendMail :: [Text] -> Text -> IO (Either Text ())
+sendMail mailTo body =
+  let from = Just "no-reply@leboncoin-listener.com"
+  in  safeSendMail from (map T.unpack $ mailTo) (T.unpack body)
+
+safeSendMail :: Maybe String -> [String] -> String -> IO (Either Text ())
+safeSendMail from to body =
+  mapLeft (T.pack . show) <$> (try (sendmail from to body) :: IO (Either SomeException ()))
diff --git a/src/Page.hs b/src/Page.hs
index da15ce4..443f768 100644
--- a/src/Page.hs
+++ b/src/Page.hs
@@ -11,13 +11,11 @@ import Network.HTTP (simpleHTTP, getRequest, getResponseBody)
 
 import Model.URL
 
+import Utils.Either (mapLeft)
+
 getPage :: URL -> IO (Either Text Text)
 getPage url =
   mapLeft (T.pack . show) <$> (try (unsafeGetPage url) :: IO (Either SomeException Text))
 
 unsafeGetPage :: URL -> IO Text
 unsafeGetPage url = simpleHTTP (getRequest (T.unpack url)) >>= (\x -> T.pack <$> getResponseBody x)
-
-mapLeft :: (a -> c) -> Either a b -> Either c b
-mapLeft f (Left l) = Left (f l)
-mapLeft _ (Right r) = (Right r)
diff --git a/src/Utils/Either.hs b/src/Utils/Either.hs
new file mode 100644
index 0000000..5d62dcc
--- /dev/null
+++ b/src/Utils/Either.hs
@@ -0,0 +1,7 @@
+module Utils.Either
+  ( mapLeft
+  ) where
+
+mapLeft :: (a -> c) -> Either a b -> Either c b
+mapLeft f (Left l) = Left (f l)
+mapLeft _ (Right r) = (Right r)
-- 
cgit v1.2.3